Theory ODE_Auxiliarities

section ‹Auxiliary Lemmas›
theory ODE_Auxiliarities
imports
  "HOL-Analysis.Analysis"
  "HOL-Library.Float"
  "List-Index.List_Index"
  Affine_Arithmetic.Affine_Arithmetic_Auxiliarities
  Affine_Arithmetic.Executable_Euclidean_Space
begin

instantiation prod :: (zero_neq_one, zero_neq_one) zero_neq_one
begin

definition "1 = (1, 1)"

instance by standard (simp add: zero_prod_def one_prod_def)
end

subsection ‹there is no inner product for type @{typ "'a L 'b"}

lemma (in real_inner) parallelogram_law: "(norm (x + y))2 + (norm (x - y))2 = 2 * (norm x)2 + 2 * (norm y)2"
proof -
  have "(norm (x + y))2 + (norm (x - y))2 = inner (x + y) (x + y) + inner (x - y) (x - y)"
    by (simp add: norm_eq_sqrt_inner)
  also have " = 2 * (norm x)2 + 2 * (norm y)2"
    by (simp add: algebra_simps norm_eq_sqrt_inner)
  finally show ?thesis .
qed

locale no_real_inner
begin

lift_definition fstzero::"(real*real) L (real*real)" is "λ(x, y). (x, 0)"
  by (auto intro!: bounded_linearI')

lemma [simp]: "fstzero (a, b) = (a, 0)"
  by transfer simp

lift_definition zerosnd::"(real*real) L (real*real)" is "λ(x, y). (0, y)"
  by (auto intro!: bounded_linearI')

lemma [simp]: "zerosnd (a, b) = (0, b)"
  by transfer simp

lemma fstzero_add_zerosnd: "fstzero + zerosnd = id_blinfun"
  by transfer auto

lemma norm_fstzero_zerosnd: "norm fstzero = 1" "norm zerosnd = 1" "norm (fstzero - zerosnd) = 1"
  by (rule norm_blinfun_eqI[where x="(1, 0)"]) (auto simp: norm_Pair blinfun.bilinear_simps
    intro: norm_blinfun_eqI[where x="(0, 1)"] norm_blinfun_eqI[where x="(1, 0)"])

text ‹compare with @{thm parallelogram_law}

lemma "(norm (fstzero + zerosnd))2 + (norm (fstzero - zerosnd))2 
    2 * (norm fstzero)2 + 2 * (norm zerosnd)2"
  by (simp add: fstzero_add_zerosnd norm_fstzero_zerosnd)

end

subsection ‹Topology›

subsection ‹Vector Spaces›

lemma ex_norm_eq_1: "x. norm (x::'a::{real_normed_vector, perfect_space}) = 1"
  by (metis vector_choose_size zero_le_one)

subsection ‹Reals›

subsection ‹Balls›

text ‹sometimes @{thm mem_ball} etc. are not good [simp]› rules (although they are often useful):
  not sure that inequalities are ``simpler'' than set membership (distorts automatic reasoning
  when only sets are involved)›
lemmas [simp del] = mem_ball mem_cball mem_sphere mem_ball_0 mem_cball_0


subsection ‹Boundedness›

lemma bounded_subset_cboxE:
  assumes "i. i  Basis  bounded ((λx. x  i) ` X)"
  obtains a b where "X  cbox a b"
proof -
  have "i. i  Basis  a b. ((λx. x  i) ` X)  {a..b}"
    by (metis box_real(2) box_subset_cbox subset_trans bounded_subset_box_symmetric[OF assms] )
  then obtain a b where bnds: "i. i  Basis  ((λx. x  i) ` X)  {a i .. b i}" 
    by metis
  then have "X  {x. iBasis. x  i  {a i .. b i}}"
    by force
  also have " = cbox (iBasis. a i *R i) (iBasis. b i *R i)"
    by (auto simp: cbox_def)
  finally show ?thesis ..
qed

lemma
  bounded_euclideanI:
  assumes "i. i  Basis  bounded ((λx. x  i) ` X)"
  shows "bounded X"
proof -
  from bounded_subset_cboxE[OF assms] obtain a b where "X  cbox a b" .
  with bounded_cbox show ?thesis by (rule bounded_subset)
qed

subsection ‹Intervals›

notation closed_segment ("(1{_--_})")
notation open_segment ("(1{_<--<_})")

lemma min_zero_mult_nonneg_le: "0  h'  h'  h  min 0 (h * k::real)  h' * k"
  by (metis dual_order.antisym le_cases min_le_iff_disj mult_eq_0_iff mult_le_0_iff
      mult_right_mono_neg)

lemma max_zero_mult_nonneg_le: "0  h'  h'  h  h' * k  max 0 (h * k::real)"
  by (metis dual_order.antisym le_cases le_max_iff_disj mult_eq_0_iff mult_right_mono
      zero_le_mult_iff)

lemmas closed_segment_eq_real_ivl = closed_segment_eq_real_ivl

lemma bdd_above_is_intervalI: "bdd_above I" if "is_interval I" "a  b" "a  I" "b  I" for I::"real set"
  by (meson bdd_above_def is_interval_1 le_cases that)

lemma bdd_below_is_intervalI: "bdd_below I" if "is_interval I" "a  b" "a  I" "b  I" for I::"real set"
  by (meson bdd_below_def is_interval_1 le_cases that)


subsection ‹Extended Real Intervals›

subsection ‹Euclidean Components›

subsection ‹Operator Norm›

subsection ‹Limits›

lemma eventually_open_cball:
  assumes "open X"
  assumes "x  X"
  shows "eventually (λe. cball x e  X) (at_right 0)"
proof -
  from open_contains_cball_eq[OF assms(1)] assms(2)
  obtain e where "e > 0" "cball x e  X" by auto
  thus ?thesis
    by (auto simp: eventually_at dist_real_def mem_cball intro!: exI[where x=e])
qed

subsection ‹Continuity›

subsection ‹Derivatives›

lemma
  if_eventually_has_derivative:
  assumes "(f has_derivative F') (at x within S)"
  assumes "F x in at x within S. P x" "P x" "x  S"
  shows "((λx. if P x then f x else g x) has_derivative F') (at x within S)"
  using assms(1)
  apply (rule has_derivative_transform_eventually)
  subgoal using assms(2) by eventually_elim auto
  by (auto simp: assms)


lemma norm_le_in_cubeI: "norm x  norm y"
  if "i. i  Basis  abs (x  i)  abs (y  i)" for x y
  unfolding norm_eq_sqrt_inner
  apply (subst euclidean_inner)
  apply (subst (3) euclidean_inner)
  using that
  by (auto intro!: sum_mono simp: abs_le_square_iff power2_eq_square[symmetric])

lemma has_derivative_partials_euclidean_convexI:
  fixes f::"'a::euclidean_space  'b::real_normed_vector"
  assumes f': "i x xi. i  Basis  (jBasis. x  j  X j)  xi = x  i 
    ((λp. f (x + (p - x  i) *R i)) has_vector_derivative f' i x) (at xi within X i)"
  assumes df_cont: "i. i  Basis  (f' i  (f' i x)) (at x within {x. jBasis. x  j  X j})"
  assumes "i. i  Basis  x  i  X i"
  assumes "i. i  Basis  convex (X i)"
  shows "(f has_derivative (λh. jBasis. (h  j) *R f' j x)) (at x within {x. jBasis. x  j  X j})"
    (is "_ (at x within ?S)")
proof (rule has_derivativeI)
  show "bounded_linear (λh. jBasis. (h  j) *R f' j x)"
    by (auto intro!: bounded_linear_intros)

  obtain E where [simp]: "set E = (Basis::'a set)" "distinct E"
    using finite_distinct_list[OF finite_Basis] by blast

  have [simp]: "length E = DIM('a)"
    using ‹distinct E distinct_card by fastforce
  have [simp]: "E ! j  Basis" if "j < DIM('a)" for j
    by (metis ‹length E = DIM('a) ‹set E = Basis› nth_mem that)
  have "convex ?S"
    by (rule convex_prod) (use assms in auto)

  have sum_Basis_E: "sum g Basis = (j<DIM('a). g (E ! j))" for g
    apply (rule sum.reindex_cong[OF _ _ refl])
    apply (auto simp: inj_on_nth)
    by (metis ‹distinct E ‹length E = DIM('a) ‹set E = Basis› bij_betw_def bij_betw_nth)

  have segment: "F x' in at x within ?S. x'  ?S" "F x' in at x within ?S. x'  x"
    unfolding eventually_at_filter by auto


  show "((λy. (f y - f x - (jBasis. ((y - x)  j) *R f' j x)) /R norm (y - x))  0) (at x within {x. jBasis. x  j  X j})"
    apply (rule tendstoI)
    unfolding norm_conv_dist[symmetric]
  proof -
    fix e::real
    assume "e > 0"
    define B where "B = e / norm (2*DIM('a) + 1)"
    with e > 0 have B_thms: "B > 0" "2 * DIM('a) * B < e" "B  0"
      by (auto simp: divide_simps algebra_simps B_def)
    define B' where "B' = B / 2"
    have "B' > 0" by (simp add: B'_def 0 < B)
    have "i  Basis. F xa in at x within {x. jBasis. x  j  X j}. dist (f' i xa) (f' i x) < B'"
      apply (rule ballI)
      subgoal premises prems using df_cont[OF prems, THEN tendstoD, OF 0 < B'] .
      done
    from eventually_ball_finite[OF finite_Basis this]
    have "F x' in at x within {x. jBasis. x  j  X j}. jBasis. dist (f' j x') (f' j x) < B'" .
    then obtain d where "d > 0"
      and "x' j. x'  {x. jBasis. x  j  X j}  x'  x  dist x' x < d  j  Basis  dist (f' j x') (f' j x) < B'"
      using 0 < B'
      by (auto simp: eventually_at)
    then have B': "x'  {x. jBasis. x  j  X j}  dist x' x < d  j  Basis  dist (f' j x') (f' j x) < B'" for x' j
      by (cases "x' = x", auto simp add: 0 < B')
    then have B: "norm (f' j x' - f' j y) < B" if
      "(j. j  Basis  x'  j  X j)"
      "(j. j  Basis  y  j  X j)"
      "dist x' x < d"
      "dist y x < d"
      "j  Basis"
      for x' y j
    proof -
      have "dist (f' j x') (f' j x) < B'" "dist (f' j y) (f' j x) < B'"
        using that
        by (auto intro!: B')
      then have "dist (f' j x') (f' j y) < B' + B'" by norm
      also have " = B" by (simp add: B'_def)
      finally show ?thesis by (simp add: dist_norm)
    qed
    have "F x' in at x within {x. jBasis. x  j  X j}. dist x' x < d"
      by (rule tendstoD[OF tendsto_ident_at d > 0])
    with segment
    show "F x' in at x within {x. jBasis. x  j  X j}.
      norm ((f x' - f x - (jBasis. ((x' - x)  j) *R f' j x)) /R norm (x' - x)) < e"
    proof eventually_elim
      case (elim x')
      then have os_subset: "open_segment x x'  ?S"
        using ‹convex ?S assms(3)
        unfolding convex_contains_open_segment
        by auto
      then have cs_subset: "closed_segment x x'  ?S"
        using elim assms(3) by (auto simp add: open_segment_def)
      have csc_subset: "closed_segment (x'  i) (x  i)  X i" if i: "i  Basis" for i
        apply (rule closed_segment_subset)
        using cs_subset elim assms(3,4) that
        by (auto )
      have osc_subset: "open_segment (x'  i) (x  i)  X i" if i: "i  Basis" for i
        using segment_open_subset_closed csc_subset[OF i]
        by (rule order_trans)

      define h where "h = x' - x"
      define z where "z j = (k<j. (h  E ! k) *R (E ! k))" for j
      define g where "g j t = (f (x + z j + (t - x  E ! j) *R E ! j))" for j t
      have z: "z j  E ! j = 0" if "j < DIM('a)" for j
        using that
        by (auto simp: z_def h_def algebra_simps inner_sum_left inner_Basis if_distrib
            nth_eq_iff_index_eq
            sum.delta
            intro!: euclidean_eqI[where 'a='a]
            cong: if_cong)
      from distinct_Ex1[OF ‹distinct E, unfolded ‹set E = Basis› Ex1_def ‹length E = _]
      obtain index where
        index: "i. i  Basis  i = E ! index i" "i. i  Basis  index i < DIM('a)"
        and unique: "i j. i  Basis  j < DIM('a)  E ! j = i  j = index i"
        by metis
      have nth_eq_iff_index: "E ! k = i  index i = k" if "i  Basis" "k < DIM('a)" for k i
        using unique[OF that] index[OF i  Basis›]
        by auto
      have z_inner: "z j  i = (if j  index i then 0 else h  i)" if "j < DIM('a)" "i  Basis" for j i
        using that index[of i]
        by (auto simp: z_def h_def algebra_simps inner_sum_left inner_Basis if_distrib
            sum.delta nth_eq_iff_index
            intro!: euclidean_eqI[where 'a='a]
            cong: if_cong)
      have z_mem: "j < DIM('a)  ja  Basis  x  ja + z j  ja  X ja" for j ja
        using csc_subset
        by (auto simp: z_inner h_def algebra_simps)
      have "norm (x' - x) < d"
        using elim by (simp add: dist_norm)
      have norm_z': "y  closed_segment (x  E ! j) (x'  E ! j)  norm (z j + y *R E ! j - (x  E ! j) *R E ! j) < d"
        if "j < DIM('a)"
        for j y
        apply (rule le_less_trans[OF _ ‹norm (x' - x) < d])
        apply (rule norm_le_in_cubeI)
        apply (auto simp: inner_diff_left inner_add_left inner_Basis that z)
        subgoal by (auto simp: closed_segment_eq_real_ivl split: if_splits)
        subgoal for i
          using that
          by (auto simp: z_inner h_def algebra_simps)
        done
      have norm_z: "norm (z j) < d" if "j < DIM('a)" for j
        using norm_z'[OF that ends_in_segment(1)]
        by (auto simp: z_def)
      {
        fix j
        assume j: "j < DIM('a)"
        have eq: "(x + z j + ((y - (x + z j))  E ! j) *R E ! j +
          (p - (x + z j + ((y - (x + z j))  E ! j) *R E ! j)  E ! j) *R
          E ! j) = (x + z j + (p - (x  E ! j)) *R E ! j)" for y p
          by (auto simp: algebra_simps j z)
        have f_has_derivative: "((λp. f (x + z j + (p - x  E ! j) *R E ! j)) has_derivative (λxa. xa *R f' (E ! j) (x + z j + ((y *R E ! j - (x + z j))  E ! j) *R E ! j)))
            (at y within closed_segment (x  E ! j) (x'  E ! j))"
          if "y  closed_segment (x  E ! j) (x'  E ! j)"
          for y
          apply (rule has_derivative_subset)
           apply (rule f'[unfolded has_vector_derivative_def,
                where x= "x + z j + ((y *R E!j - (x + z j)) E!j) *R E ! j" and i="E ! j", unfolded eq])
          subgoal by (simp add: j)
          subgoal
            using that
            apply (auto simp: algebra_simps z j inner_Basis)
            using closed_segment_commute E ! j  Basis› csc_subset apply blast
            by (simp add: z_mem j)
          subgoal by (auto simp: algebra_simps z j inner_Basis)
          subgoal
            apply (auto simp: algebra_simps z j inner_Basis)
            using closed_segment_commute j. j < DIM('a)  E ! j  Basis› csc_subset j apply blast
            done
          done
        have *: "((xa *R E ! j - (x + z j))  E ! j) = xa - x  E ! j" for xa
          by (auto simp: algebra_simps z j)
        have g': "(g j has_vector_derivative (f' (E ! j) (x + z j + (xa - x  E ! j) *R E ! j)))
          (at xa within (closed_segment (xE!j) (x'E!j)))"
          (is "(_ has_vector_derivative ?g' j xa) _")
          if "xa  closed_segment (xE!j) (x'E!j)" for xa
          using that
          by (auto simp: has_vector_derivative_def g_def[abs_def] *
              intro!: derivative_eq_intros f_has_derivative[THEN has_derivative_eq_rhs])
        define g' where "g' j = ?g' j" for j
        with g' have g': "(g j has_vector_derivative g' j t) (at t within closed_segment (xE!j) (x'E!j))"
          if "t  closed_segment (xE!j) (x'E!j)"
          for t
          by (simp add: that)
        have cont_bound: "y. yclosed_segment (x  E ! j) (x'  E ! j)  norm (g' j y - g' j (x  E ! j))  B"
          apply (auto simp add: g'_def j algebra_simps inner_Basis z dist_norm
              intro!: less_imp_le B z_mem norm_z norm_z')
          using closed_segment_commute j. j < DIM('a)  E ! j  Basis› csc_subset j apply blast
          done
        from vector_differentiable_bound_linearization[OF g' order_refl cont_bound ends_in_segment(1)]
        have n: "norm (g j (x'  E ! j) - g j (x  E ! j) - (x'  E ! j - x  E ! j) *R g' j (x  E ! j))  norm (x'  E ! j - x  E ! j) * B"
          .
        have "z (Suc j) = z j + (x'  E ! j - x  E ! j) *R E ! j"
          by (auto simp: z_def h_def algebra_simps)
        then have "f (x + z (Suc j)) = f (x + z j + (x'  E ! j - x  E ! j) *R E ! j) "
          by (simp add: ac_simps)
        with n have "norm (f (x + z (Suc j)) - f (x + z j) - (x'  E ! j - x  E ! j) *R f' (E ! j) (x + z j))  ¦x'  E ! j - x  E ! j¦ * B"
          by (simp add: g_def g'_def)
      } note B_le = this
      have B': "norm (f' (E ! j) (x + z j) - f' (E ! j) x)  B" if "j < DIM('a)" for j
        using that assms(3)
        by (auto simp add: algebra_simps inner_Basis z dist_norm 0 < d
            intro!: less_imp_le B z_mem norm_z)
      have "(jDIM('a) - 1. f (x + z j) - f (x + z (Suc j))) = f (x + z 0) - f (x + z (Suc (DIM('a) - 1)))"
        by (rule sum_telescope)
      moreover have "z DIM('a) = h"
        using index
        by (auto simp: z_def h_def algebra_simps inner_sum_left inner_Basis if_distrib
            nth_eq_iff_index 
            sum.delta 
            intro!: euclidean_eqI[where 'a='a]
            cong: if_cong)
      moreover have "z 0 = 0"
        by (auto simp: z_def)
      moreover have "{..DIM('a) - 1} = {..<DIM('a)}"
        using le_imp_less_Suc by fastforce
      ultimately have "f x - f (x + h) = (j<DIM('a). f (x + z j) - f (x + z (Suc j)))"
        by (auto simp: )
      then have "norm (f (x + h) - f x - (jBasis. ((x' - x)  j) *R f' j x)) =
        norm(
          (j<DIM('a). f (x + z (Suc j)) - f (x + z j) - (x'  E ! j - x  E ! j) *R f' (E ! j) (x + z j)) +
          (j<DIM('a). (x'  E ! j - x  E ! j) *R (f' (E ! j) (x + z j) - f' (E ! j) x)))"
        (is "_ = norm (sum ?a ?E + sum ?b ?E)")
        by (intro arg_cong[where f=norm]) (simp add: sum_negf sum_subtractf sum.distrib algebra_simps sum_Basis_E)
      also have "  norm (sum ?a ?E) + norm (sum ?b ?E)" by (norm)
      also have "norm (sum ?a ?E)  sum (λx. norm (?a x)) ?E"
        by (rule norm_sum)
      also have "  sum (λj. norm ¦x'  E ! j - x  E ! j¦ * B) ?E"
        by (auto intro!: sum_mono B_le)
      also have "  sum (λj. norm (x' - x) * B) ?E"
        apply (rule sum_mono)
        apply (auto intro!: mult_right_mono 0  B)
        by (metis (full_types) j. j < DIM('a)  E ! j  Basis› inner_diff_left norm_bound_Basis_le order_refl)
      also have " = norm (x' - x) * DIM('a) * B"
        by simp
      also have "norm (sum ?b ?E)  sum (λx. norm (?b x)) ?E"
        by (rule norm_sum)
      also have "  sum (λj. norm (x' - x) * B) ?E"
        apply (intro sum_mono)
        apply (auto intro!: mult_mono B')
         apply (metis (full_types) j. j < DIM('a)  E ! j  Basis› inner_diff_left norm_bound_Basis_le order_refl)
        done
      also have " = norm (x' - x) * DIM('a) * B"
        by simp
      finally have "norm (f (x + h) - f x - (jBasis. ((x' - x)  j) *R f' j x)) 
          norm (x' - x) * real DIM('a) * B + norm (x' - x) * real DIM('a) * B"
        by arith
      also have " /R norm (x' - x)  norm (2 * DIM('a) * B)"
        using B  0
        by (simp add: divide_simps abs_mult)
      also have " < e" using B_thms by simp
      finally show ?case by (auto simp: divide_simps abs_mult h_def)
    qed
  qed
qed

lemma
  frechet_derivative_equals_partial_derivative:
  fixes f::"'a::euclidean_space  'a"
  assumes Df: "x. (f has_derivative Df x) (at x)"
  assumes f': "((λp. f (x + (p - x  i) *R i)  b) has_real_derivative f' x i b) (at (x  i))"
  shows "Df x i  b = f' x i b"
proof -
  define Dfb where "Dfb x = Blinfun (Df x)" for x
  have Dfb_apply: "blinfun_apply (Dfb x) = Df x" for x
    unfolding Dfb_def
    apply (rule bounded_linear_Blinfun_apply)
    apply (rule has_derivative_bounded_linear)
    apply (rule assms)
    done
  have "Dfb x = blinfun_of_matrix (λi b. Dfb x b  i)" for x
    using blinfun_of_matrix_works[of "Dfb x"] by auto
  have Dfb: "x. (f has_derivative Dfb x) (at x)"
    by (auto simp: Dfb_apply Df)
  note [derivative_intros] = diff_chain_at[OF _ Dfb, unfolded o_def]
  have "((λp. f (x + (p - x  i) *R i)  b) has_real_derivative Dfb x i  b) (at (x  i))"
    by (auto intro!: derivative_eq_intros ext simp: has_field_derivative_def blinfun.bilinear_simps)
  from DERIV_unique[OF f' this]
  show ?thesis by (simp add: Dfb_apply)
qed


subsection ‹Integration›

lemmas content_real[simp]
lemmas integrable_continuous[intro, simp]
  and integrable_continuous_real[intro, simp]


lemma integral_eucl_le:
  fixes f g::"'a::euclidean_space  'b::ordered_euclidean_space"
  assumes "f integrable_on s"
    and "g integrable_on s"
    and "x. x  s  f x  g x"
  shows "integral s f  integral s g"
  using assms
  by (auto intro!: integral_component_le simp: eucl_le[where 'a='b])

lemma
  integral_ivl_bound:
  fixes l u::"'a::ordered_euclidean_space"
  assumes "x h'. h'  {t0 .. h}  x  {t0 .. h}  (h' - t0) *R f x  {l .. u}"
  assumes "t0  h"
  assumes f_int: "f integrable_on {t0 .. h}"
  shows "integral {t0 .. h} f  {l .. u}"
proof -
  from assms(1)[of t0 t0] assms(2) have "0  {l .. u}" by auto
  have "integral {t0 .. h} f = integral {t0 .. h} (λt. if t  {t0, h} then 0 else f t)"
    by (rule integral_spike[where S="{t0, h}"]) auto
  also
  {
    fix x
    assume 1: "x  {t0 <..< h}"
    with assms have "(h - t0) *R f x  {l .. u}" by auto
    then have "(if x  {t0, h} then 0 else f x)  {l /R (h - t0) .. u /R (h - t0)}"
      using x  _
      by (auto simp: inverse_eq_divide
        simp: eucl_le[where 'a='a] field_simps algebra_simps)
  }
  then have "  {integral {t0..h} (λ_. l /R (h - t0)) .. integral {t0..h} (λ_. u /R (h - t0))}"
    unfolding atLeastAtMost_iff
    apply (safe intro!: integral_eucl_le)
    using 0  {l .. u}
    apply (auto intro!: assms
      intro: integrable_continuous_real  integrable_spike[where S="{t0, h}", OF f_int]
      simp: eucl_le[where 'a='a] divide_simps
      split: if_split_asm)
    done
  also have "  {l .. u}"
    using assms 0  {l .. u}
    by (auto simp: inverse_eq_divide)
  finally show ?thesis .
qed

lemma
  add_integral_ivl_bound:
  fixes l u::"'a::ordered_euclidean_space"
  assumes "x h'. h'  {t0 .. h}  x  {t0 .. h}  (h' - t0) *R f x  {l - x0 .. u - x0}"
  assumes "t0  h"
  assumes f_int: "f integrable_on {t0 .. h}"
  shows "x0 + integral {t0 .. h} f  {l .. u}"
  using integral_ivl_bound[OF assms]
  by (auto simp: algebra_simps)

subsection ‹conditionally complete lattice›


subsection ‹Lists›

lemma
  Ball_set_Cons[simp]: "(aset_Cons x y. P a)  (ax. by. P (a#b))"
  by (auto simp: set_Cons_def)

lemma set_cons_eq_empty[iff]: "set_Cons a b = {}  a = {}  b = {}"
  by (auto simp: set_Cons_def)

lemma listset_eq_empty_iff[iff]: "listset XS = {}  {}  set XS"
  by (induction XS) auto

lemma sing_in_sings[simp]: "[x]  (λx. [x]) ` xd  x  xd"
  by auto

lemma those_eq_None_set_iff: "those xs = None  None  set xs"
  by (induction xs) (auto split: option.split)

lemma those_eq_Some_lengthD: "those xs = Some ys  length xs = length ys"
  by (induction xs arbitrary: ys) (auto split: option.splits)

lemma those_eq_Some_map_Some_iff: "those xs = Some ys  (xs = map Some ys)" (is "?l  ?r")
proof safe
  assume ?l
  then have "length xs = length ys"
    by (rule those_eq_Some_lengthD)
  then show ?r using ?l
    by (induction xs ys rule: list_induct2) (auto split: option.splits)
next
  assume ?r
  then have "length xs = length ys"
    by simp
  then show "those (map Some ys) = Some ys" using ?r
    by (induction xs ys rule: list_induct2) (auto split: option.splits)
qed


subsection ‹Set(sum)›

subsection ‹Max›

subsection ‹Uniform Limit›

subsection ‹Bounded Linear Functions›

lift_definition comp3::― ‹TODO: name?›
  "('c::real_normed_vector L 'd::real_normed_vector)  ('b::real_normed_vector L 'c) L 'b L 'd" is
  "λ(cd::('c L 'd)) (bc::'b L 'c). (cd oL bc)"
  by (rule bounded_bilinear.bounded_linear_right[OF bounded_bilinear_blinfun_compose])

lemma blinfun_apply_comp3[simp]: "blinfun_apply (comp3 a) b = (a oL b)"
  by (simp add: comp3.rep_eq)

lemma bounded_linear_comp3[bounded_linear]: "bounded_linear comp3"
  by transfer (rule bounded_bilinear_blinfun_compose)

lift_definition comp12::― ‹TODO: name?›
  "('a::real_normed_vector L 'c::real_normed_vector)  ('b::real_normed_vector L 'c)  ('a × 'b) L 'c"
  is "λf g (a, b). f a + g b"
  by (auto intro!: bounded_linear_intros
    intro: bounded_linear_compose
    simp: split_beta')

lemma blinfun_apply_comp12[simp]: "blinfun_apply (comp12 f g) b = f (fst b) + g (snd b)"
  by (simp add: comp12.rep_eq split_beta)


subsection ‹Order Transitivity Attributes›

attribute_setup le = ‹Scan.succeed (Thm.rule_attribute [] (fn context => fn thm => thm RS @{thm order_trans}))
  "transitive version of inequality (useful for intro)"
attribute_setup ge = ‹Scan.succeed (Thm.rule_attribute [] (fn context => fn thm => thm RS @{thm order_trans[rotated]}))
  "transitive version of inequality (useful for intro)"


subsection ‹point reflection›

definition preflect::"'a::real_vector  'a  'a" where "preflect  λt0 t. 2 *R t0 - t"

lemma preflect_preflect[simp]: "preflect t0 (preflect t0 t) = t"
  by (simp add: preflect_def algebra_simps)

lemma preflect_preflect_image[simp]: "preflect t0 ` preflect t0 ` S = S"
  by (simp add: image_image)

lemma is_interval_preflect[simp]: "is_interval (preflect t0 ` S)  is_interval S"
  by (auto simp: preflect_def[abs_def])

lemma iv_in_preflect_image[intro, simp]: "t0  T  t0  preflect t0 ` T"
  by (auto intro!: image_eqI simp: preflect_def algebra_simps scaleR_2)

lemma preflect_tendsto[tendsto_intros]:
  fixes l::"'a::real_normed_vector"
  shows "(g  l) F  (h  m) F  ((λx. preflect (g x) (h x))  preflect l m) F"
  by (auto intro!: tendsto_eq_intros simp: preflect_def)

lemma continuous_preflect[continuous_intros]:
  fixes a::"'a::real_normed_vector"
  shows "continuous (at a within A) (preflect t0)"
  by (auto simp: continuous_within intro!: tendsto_intros)

lemma
  fixes t0::"'a::ordered_real_vector"
  shows preflect_le[simp]: "t0  preflect t0 b  b  t0"
    and le_preflect[simp]: "preflect t0 b  t0  t0  b"
    and antimono_preflect: "antimono (preflect t0)"
    and preflect_le_preflect[simp]: "preflect t0 a  preflect t0 b  b  a"
    and preflect_eq_cancel[simp]: "preflect t0 a = preflect t0 b  a = b"
  by (auto intro!: antimonoI simp: preflect_def scaleR_2)

lemma preflect_eq_point_iff[simp]: "t0 = preflect t0 s  t0 = s" "preflect t0 s = t0  t0 = s"
  by (auto simp: preflect_def algebra_simps scaleR_2)

lemma preflect_minus_self[simp]: "preflect t0 s - t0 = t0 - s"
  by (simp add: preflect_def scaleR_2)

end

Theory MVT_Ex

theory MVT_Ex
imports
  "HOL-Analysis.Analysis"
  "HOL-Decision_Procs.Approximation"
  "../ODE_Auxiliarities"
begin

subsection ‹(Counter)Example of Mean Value Theorem in Euclidean Space \label{sec:countermvt}›

text ‹There is no exact analogon of the mean value theorem in the multivariate case!›

lemma MVT_wrong: assumes
  "J a u (f::real*realreal*real).
      (x. FDERIV f x :> J x) 
      (t{0<..<1}. f (a + u) - f a = J (a + t *R u) u)"
  shows "False"
proof -
  have "t::real*real. FDERIV (λt. (cos (fst t), sin (fst t))) t :> (λh. (- ((fst h) * sin (fst t)), (fst h) * cos (fst t)))"
    by (auto intro!: derivative_eq_intros)
  from assms[OF this, of "(pi, pi)" "(pi, pi)"] obtain t::real where t: "0 < t" "t < 1" and
    "pi * sin (t * pi) = 2" "cos (t * pi) = 0"
    by auto
  then obtain n where tpi: "t * pi = real_of_int n * (pi / 2)" and "odd n"
    by (auto simp: cos_zero_iff_int)
  then have teq: "t = real_of_int n / 2" by auto
  then have "n = 1" using t ‹odd n by arith
  then have "t = 1/2" using teq by simp
  have "sin (t * pi) = 1"
    by (simp add: t = 1/2 sin_eq_1)
  with ‹pi * sin (t * pi) = 2
  have "pi = 2" by simp
  moreover have "pi > 2" using pi_approx by simp
  ultimately show False by simp
qed

lemma MVT_corrected:
  fixes f::"'a::ordered_euclidean_space'b::euclidean_space"
  assumes fderiv: "x. x  D  (f has_derivative J x) (at x within D)"
  assumes line_in: "x. 0  x; x  1  a + x *R u  D"
  shows "(tBasis{0<..<1}. (f (a + u) - f a) = (iBasis. (J (a + t i *R u) u  i) *R i))"
proof -
  {
    fix i::'b
    assume "i  Basis"
    have subset: "((λx. a + x *R u) ` {0..1})  D"
      using line_in by force
    have "x. 0  x; x  1  ((λb. f (a + b *R u)  i) has_derivative (λb. b *R J (a + x *R u) u  i)) (at x within {0..1})"
      using line_in
      by (auto intro!: derivative_eq_intros
        has_derivative_subset[OF _ subset]
        has_derivative_in_compose[where f="λx. a + x *R u"]
        fderiv line_in
        simp add: linear.scaleR[OF has_derivative_linear[OF fderiv]])
    with zero_less_one
    have "x{0<..<1}. f (a + 1 *R u)  i - f (a + 0 *R u)  i = (1 - 0) *R J (a + x *R u) u  i"
      by (rule mvt_simple)
  }
  then obtain t where "iBasis. t i  {0<..<1}  f (a + u)  i - f a  i = J (a + t i *R u) u  i"
    by atomize_elim (force intro!: bchoice)
  hence "t  Basis  {0<..<1}" "i. i  Basis  (f (a + u) - f a)  i = J (a + t i *R u) u  i"
    by (auto simp: inner_diff_left)
  moreover hence "(f (a + u) - f a) = (iBasis. (J (a + t i *R u) u  i) *R i)"
    by (intro euclidean_eqI[where 'a='b]) simp
  ultimately show ?thesis by blast
qed

lemma MVT_ivl:
  fixes f::"'a::ordered_euclidean_space'b::ordered_euclidean_space"
  assumes fderiv: "x. x  D  (f has_derivative J x) (at x within D)"
  assumes J_ivl: "x. x  D  J x u  {J0 .. J1}"
  assumes line_in: "x. x  {0..1}  a + x *R u  D"
  shows "f (a + u) - f a  {J0..J1}"
proof -
  from MVT_corrected[OF fderiv line_in] obtain t where
    t: "tBasis  {0<..<1}" and
    mvt: "f (a + u) - f a = (iBasis. (J (a + t i *R u) u  i) *R i)"
    by auto
  note mvt
  also have "  {J0 .. J1}"
  proof -
    have J: "i. i  Basis  J0  J (a + t i *R u) u"
            "i. i  Basis  J (a + t i *R u) u  J1"
      using J_ivl t line_in by (auto simp: Pi_iff)
    show ?thesis
      using J
      unfolding atLeastAtMost_iff eucl_le[where 'a='b]
      by auto
  qed
  finally show ?thesis .
qed

lemma MVT:
  shows
  "J J0 J1 a u (f::real*realreal*real).
    (x. FDERIV f x :> J x) 
    (x. J x u  {J0 .. J1}) 
    f (a + u) - f a  {J0 .. J1}"
  by (rule_tac J = J in MVT_ivl[where D=UNIV]) auto

lemma MVT_ivl':
  fixes f::"'a::ordered_euclidean_space'b::ordered_euclidean_space"
  assumes fderiv: "(x. x  D  (f has_derivative J x) (at x within D))"
  assumes J_ivl: "x. x  D  J x (a - b)  {J0..J1}"
  assumes line_in: "x. x  {0..1}  b + x *R (a - b)  D"
  shows "f a  {f b + J0..f b + J1}"
proof -
  have "f (b + (a - b)) - f b  {J0 .. J1}"
    using J_ivl MVT_ivl fderiv line_in by blast
  thus ?thesis
    by (auto simp: diff_le_eq le_diff_eq ac_simps)
qed

end

Theory Vector_Derivative_On

theory
  Vector_Derivative_On
imports
  "HOL-Analysis.Analysis"
begin

subsection ‹Vector derivative on a set›
  ― ‹TODO: also for the other derivatives?!›
  ― ‹TODO: move to repository and rewrite assumptions of common lemmas?›

definition
  has_vderiv_on :: "(real  'a::real_normed_vector)  (real  'a)  real set  bool"
  (infix "(has'_vderiv'_on)" 50)
where
  "(f has_vderiv_on f') S  (x  S. (f has_vector_derivative f' x) (at x within S))"

lemma has_vderiv_on_empty[intro, simp]: "(f has_vderiv_on f') {}"
  by (auto simp: has_vderiv_on_def)

lemma has_vderiv_on_subset:
  assumes "(f has_vderiv_on f') S"
  assumes "T  S"
  shows "(f has_vderiv_on f') T"
  by (meson assms(1) assms(2) contra_subsetD has_vderiv_on_def has_vector_derivative_within_subset)

lemma has_vderiv_on_compose:
  assumes "(f has_vderiv_on f') (g ` T)"
  assumes "(g has_vderiv_on g') T"
  shows "(f o g has_vderiv_on (λx. g' x *R f' (g x))) T"
  using assms
  unfolding has_vderiv_on_def
  by (auto intro!: vector_diff_chain_within)

lemma has_vderiv_on_open:
  assumes "open T"
  shows "(f has_vderiv_on f') T  (t  T. (f has_vector_derivative f' t) (at t))"
  by (auto simp: has_vderiv_on_def at_within_open[OF _ ‹open T])

lemma has_vderiv_on_eq_rhs:― ‹TODO: integrate intro derivative_eq_intros›
  "(f has_vderiv_on g') T  (x. x  T  g' x = f' x)  (f has_vderiv_on f') T"
  by (auto simp: has_vderiv_on_def)

lemma [THEN has_vderiv_on_eq_rhs, derivative_intros]:
  shows has_vderiv_on_id: "((λx. x) has_vderiv_on (λx. 1)) T"
    and has_vderiv_on_const: "((λx. c) has_vderiv_on (λx. 0)) T"
  by (auto simp: has_vderiv_on_def intro!: derivative_eq_intros)

lemma [THEN has_vderiv_on_eq_rhs, derivative_intros]:
  fixes f::"real  'a::real_normed_vector"
  assumes "(f has_vderiv_on f') T"
  shows has_vderiv_on_uminus: "((λx. - f x) has_vderiv_on (λx. - f' x)) T"
  using assms
  by (auto simp: has_vderiv_on_def intro!: derivative_eq_intros)

lemma [THEN has_vderiv_on_eq_rhs, derivative_intros]:
  fixes f g::"real  'a::real_normed_vector"
  assumes "(f has_vderiv_on f') T"
  assumes "(g has_vderiv_on g') T"
  shows has_vderiv_on_add: "((λx. f x + g x) has_vderiv_on (λx. f' x + g' x)) T"
   and has_vderiv_on_diff: "((λx. f x - g x) has_vderiv_on (λx. f' x - g' x)) T"
  using assms
  by (auto simp: has_vderiv_on_def intro!: derivative_eq_intros)

lemma [THEN has_vderiv_on_eq_rhs, derivative_intros]:
  fixes f::"real  real" and g::"real  'a::real_normed_vector"
  assumes "(f has_vderiv_on f') T"
  assumes "(g has_vderiv_on g') T"
  shows has_vderiv_on_scaleR: "((λx. f x *R g x) has_vderiv_on (λx. f x *R g' x + f' x *R g x)) T"
  using assms
  by (auto simp: has_vderiv_on_def has_field_derivative_iff_has_vector_derivative
    intro!: derivative_eq_intros)

lemma [THEN has_vderiv_on_eq_rhs, derivative_intros]:
  fixes f g::"real  'a::real_normed_algebra"
  assumes "(f has_vderiv_on f') T"
  assumes "(g has_vderiv_on g') T"
  shows has_vderiv_on_mult: "((λx. f x * g x) has_vderiv_on (λx. f x * g' x + f' x * g x)) T"
  using assms
  by (auto simp: has_vderiv_on_def intro!: derivative_eq_intros)

lemma has_vderiv_on_ln[THEN has_vderiv_on_eq_rhs, derivative_intros]:
  fixes g::"real  real"
  assumes "x. x  s  0 < g x"
  assumes "(g has_vderiv_on g') s"
  shows "((λx. ln (g x)) has_vderiv_on (λx. g' x / g x)) s"
  using assms
  unfolding has_vderiv_on_def
  by (auto simp: has_vderiv_on_def has_field_derivative_iff_has_vector_derivative[symmetric]
    intro!: derivative_eq_intros)


lemma fundamental_theorem_of_calculus':
  fixes f :: "real  'a::banach"
  shows "a  b  (f has_vderiv_on f') {a .. b}  (f' has_integral (f b - f a)) {a .. b}"
  by (auto intro!: fundamental_theorem_of_calculus simp: has_vderiv_on_def)

lemma has_vderiv_on_If:
  assumes "U = S  T"
  assumes "(f has_vderiv_on f') (S  (closure T  closure S))"
  assumes "(g has_vderiv_on g') (T  (closure T  closure S))"
  assumes "x. x  closure T  x  closure S  f x = g x"
  assumes "x. x  closure T  x  closure S  f' x = g' x"
  shows "((λt. if t  S then f t else g t) has_vderiv_on (λt. if t  S then f' t else g' t)) U"
  using assms
  by (auto simp: has_vderiv_on_def ac_simps
      intro!: has_vector_derivative_If_within_closures
      split del: if_split)

lemma mvt_very_simple_closed_segmentE:
  fixes f::"realreal"
  assumes "(f has_vderiv_on f') (closed_segment a b)"
  obtains y where "y  closed_segment a b"  "f b - f a = (b - a) * f' y"
proof cases
  assume "a  b"
  with mvt_very_simple[of a b f "λx i. i *R f' x"] assms
  obtain y where "y  closed_segment a b"  "f b - f a = (b - a) * f' y"
    by (auto simp: has_vector_derivative_def closed_segment_eq_real_ivl has_vderiv_on_def)
  thus ?thesis ..
next
  assume "¬ a  b"
  with mvt_very_simple[of b a f "λx i. i *R f' x"] assms
  obtain y where "y  closed_segment a b"  "f b - f a = (b - a) * f' y"
    by (force simp: has_vector_derivative_def has_vderiv_on_def closed_segment_eq_real_ivl algebra_simps)
  thus ?thesis ..
qed

lemma mvt_simple_closed_segmentE:
  fixes f::"realreal"
  assumes "(f has_vderiv_on f') (closed_segment a b)"
  assumes "a  b"
  obtains y where "y  open_segment a b"  "f b - f a = (b - a) * f' y"
proof cases
  assume "a  b"
  with assms have "a < b" by simp
  with mvt_simple[of a b f "λx i. i *R f' x"] assms
  obtain y where "y  open_segment a b"  "f b - f a = (b - a) * f' y"
    by (auto simp: has_vector_derivative_def closed_segment_eq_real_ivl has_vderiv_on_def
        open_segment_eq_real_ivl)
  thus ?thesis ..
next
  assume "¬ a  b"
  then have "b < a" by simp
  with mvt_simple[of b a f "λx i. i *R f' x"] assms
  obtain y where "y  open_segment a b"  "f b - f a = (b - a) * f' y"
    by (force simp: has_vector_derivative_def has_vderiv_on_def closed_segment_eq_real_ivl algebra_simps
      open_segment_eq_real_ivl)
  thus ?thesis ..
qed

lemma differentiable_bound_general_open_segment:
  fixes a :: "real"
    and b :: "real"
    and f :: "real  'a::real_normed_vector"
    and f' :: "real  'a"
  assumes "continuous_on (closed_segment a b) f"
  assumes "continuous_on (closed_segment a b) g"
    and "(f has_vderiv_on f') (open_segment a b)"
    and "(g has_vderiv_on g') (open_segment a b)"
    and "x. x  open_segment a b  norm (f' x)  g' x"
  shows "norm (f b - f a)  abs (g b - g a)"
proof -
  {
    assume "a = b"
    hence ?thesis by simp
  } moreover {
    assume "a < b"
    with assms
    have "continuous_on {a .. b} f"
      and "continuous_on {a .. b} g"
      and "x. x{a<..<b}  (f has_vector_derivative f' x) (at x)"
      and "x. x{a<..<b}  (g has_vector_derivative g' x) (at x)"
      and "x. x{a<..<b}  norm (f' x)  g' x"
      by (auto simp: open_segment_eq_real_ivl closed_segment_eq_real_ivl has_vderiv_on_def
        at_within_open[where S="{a<..<b}"])
    from differentiable_bound_general[OF a < b this]
    have ?thesis by auto
  } moreover {
    assume "b < a"
    with assms
    have "continuous_on {b .. a} f"
      and "continuous_on {b .. a} g"
      and "x. x{b<..<a}  (f has_vector_derivative f' x) (at x)"
      and "x. x{b<..<a}  (g has_vector_derivative g' x) (at x)"
      and "x. x{b<..<a}  norm (f' x)  g' x"
      by (auto simp: open_segment_eq_real_ivl closed_segment_eq_real_ivl has_vderiv_on_def
        at_within_open[where S="{b<..<a}"])
    from differentiable_bound_general[OF b < a this]
    have "norm (f a - f b)  g a - g b" by simp
    also have "  abs (g b - g a)" by simp
    finally have ?thesis by (simp add: norm_minus_commute)
  } ultimately show ?thesis by arith
qed

lemma has_vderiv_on_union:
  assumes "(f has_vderiv_on g) (s  closure s  closure t)"
  assumes "(f has_vderiv_on g) (t  closure s  closure t)"
  shows "(f has_vderiv_on g) (s  t)"
  unfolding has_vderiv_on_def
proof
  fix x assume "x  s  t"
  with has_vector_derivative_If_within_closures[of x s t "s  t" f g f g] assms
  show "(f has_vector_derivative g x) (at x within s  t)"
    by (auto simp: has_vderiv_on_def)
qed

lemma has_vderiv_on_union_closed:
  assumes "(f has_vderiv_on g) s"
  assumes "(f has_vderiv_on g) t"
  assumes "closed s" "closed t"
  shows "(f has_vderiv_on g) (s  t)"
  using has_vderiv_on_If[OF refl, of f g s t f g] assms
  by (auto simp: has_vderiv_on_subset)

lemma vderiv_on_continuous_on: "(f has_vderiv_on f') S  continuous_on S f"
  by (auto intro!: continuous_on_vector_derivative simp: has_vderiv_on_def)

lemma has_vderiv_on_cong[cong]:
  assumes "x. x  S  f x = g x"
  assumes "x. x  S  f' x = g' x"
  assumes "S = T"
  shows "(f has_vderiv_on f') S = (g has_vderiv_on g') T"
  using assms
  by (metis has_vector_derivative_transform has_vderiv_on_def)

lemma has_vderiv_eq:
  assumes "(f has_vderiv_on f') S"
  assumes "x. x  S  f x = g x"
  assumes "x. x  S  f' x = g' x"
  assumes "S = T"
  shows "(g has_vderiv_on g') T"
  using assms by simp

lemma has_vderiv_on_compose':
  assumes "(f has_vderiv_on f') (g ` T)"
  assumes "(g has_vderiv_on g') T"
  shows "((λx. f (g x)) has_vderiv_on (λx. g' x *R f' (g x))) T"
  using has_vderiv_on_compose[OF assms]
  by simp

lemma has_vderiv_on_compose2:
  assumes "(f has_vderiv_on f') S"
  assumes "(g has_vderiv_on g') T"
  assumes "t. t  T  g t  S"
  shows "((λx. f (g x)) has_vderiv_on (λx. g' x *R f' (g x))) T"
  using has_vderiv_on_compose[OF has_vderiv_on_subset[OF assms(1)] assms(2)] assms(3)
  by force

lemma has_vderiv_on_singleton: "(y has_vderiv_on y') {t0}"
  by (auto simp: has_vderiv_on_def has_vector_derivative_def has_derivative_within_singleton_iff
      bounded_linear_scaleR_left)

lemma
  has_vderiv_on_zero_constant:
  assumes "convex s"
  assumes "(f has_vderiv_on (λh. 0)) s"
  obtains c where "x. x  s  f x = c"
  using has_vector_derivative_zero_constant[of s f] assms
  by (auto simp: has_vderiv_on_def)

lemma bounded_vderiv_on_imp_lipschitz:
  assumes "(f has_vderiv_on f') X"
  assumes convex: "convex X"
  assumes "x. x  X  norm (f' x)  C" "0  C"
  shows "C-lipschitz_on X f"
  using assms
  by (auto simp: has_vderiv_on_def has_vector_derivative_def onorm_scaleR_left onorm_id
    intro!: bounded_derivative_imp_lipschitz[where f' = "λx d. d *R f' x"])

end

Theory Interval_Integral_HK

theory Interval_Integral_HK
imports Vector_Derivative_On
begin

subsection ‹interval integral›
  ― ‹TODO: move to repo ?!›
  ― ‹TODO: replace with Bochner Integral?!
           But FTC for Bochner requires continuity and euclidean space!›

definition has_ivl_integral ::
    "(real  'b::real_normed_vector)  'b  real  real  bool"― ‹TODO: generalize?›
  (infixr "has'_ivl'_integral" 46)
  where "(f has_ivl_integral y) a b  (if a  b then (f has_integral y) {a .. b} else (f has_integral - y) {b .. a})"

definition ivl_integral::"real  real  (real  'a)  'a::real_normed_vector"
  where "ivl_integral a b f = integral {a .. b} f - integral {b .. a} f"

lemma integral_emptyI[simp]:
  fixes a b::real
  shows  "a  b  integral {a..b} f = 0" "a > b  integral {a..b} f = 0"
  by (cases "a = b") auto

lemma ivl_integral_unique: "(f has_ivl_integral y) a b  ivl_integral a b f = y"
  using integral_unique[of f y "{a .. b}"] integral_unique[of f "- y" "{b .. a}"]
  unfolding ivl_integral_def has_ivl_integral_def
  by (auto split: if_split_asm)

lemma fundamental_theorem_of_calculus_ivl_integral:
  fixes f :: "real  'a::banach"
  shows "(f has_vderiv_on f') (closed_segment a b)  (f' has_ivl_integral f b - f a) a b"
  by (auto simp: has_ivl_integral_def closed_segment_eq_real_ivl intro!: fundamental_theorem_of_calculus')

lemma
  fixes f :: "real  'a::banach"
  assumes "f integrable_on (closed_segment a b)"
  shows indefinite_ivl_integral_continuous:
    "continuous_on (closed_segment a b) (λx. ivl_integral a x f)"
    "continuous_on (closed_segment b a) (λx. ivl_integral a x f)"
  using assms
  by (auto simp: ivl_integral_def closed_segment_eq_real_ivl split: if_split_asm
    intro!: indefinite_integral_continuous_1 indefinite_integral_continuous_1'
      continuous_intros intro: continuous_on_eq)

lemma
  fixes f :: "real  'a::banach"
  assumes "f integrable_on (closed_segment a b)"
  assumes "c  closed_segment a b"
  shows indefinite_ivl_integral_continuous_subset:
    "continuous_on (closed_segment a b) (λx. ivl_integral c x f)"
proof -
  from assms have "f integrable_on (closed_segment c a)" "f integrable_on (closed_segment c b)"
     by (auto simp: closed_segment_eq_real_ivl integrable_on_subinterval
      integrable_on_insert_iff split: if_splits)
  then have "continuous_on (closed_segment a c  closed_segment c b) (λx. ivl_integral c x f)"
    by (auto intro!: indefinite_ivl_integral_continuous continuous_on_closed_Un)
  also have "closed_segment a c  closed_segment c b = closed_segment a b"
    using assms by (auto simp: closed_segment_eq_real_ivl)
  finally show ?thesis .
qed

lemma real_Icc_closed_segment: fixes a b::real shows "a  b  {a .. b} = closed_segment a b"
  by (auto simp: closed_segment_eq_real_ivl)

lemma ivl_integral_zero[simp]: "ivl_integral a a f = 0"
  by (auto simp: ivl_integral_def)

lemma ivl_integral_cong:
  assumes "x. x  closed_segment a b  g x = f x"
  assumes "a = c" "b = d"
  shows "ivl_integral a b f = ivl_integral c d g"
  using assms integral_spike[of "{}" "closed_segment a b" f g]
  by (auto simp: ivl_integral_def closed_segment_eq_real_ivl split: if_split_asm)

lemma ivl_integral_diff:
  "f integrable_on (closed_segment s t)  g integrable_on (closed_segment s t) 
    ivl_integral s t (λx. f x - g x) = ivl_integral s t f - ivl_integral s t g"
  using Henstock_Kurzweil_Integration.integral_diff[of f "closed_segment s t" g]
  by (auto simp: ivl_integral_def closed_segment_eq_real_ivl split: if_split_asm)

lemma ivl_integral_norm_bound_ivl_integral:
  fixes f :: "real  'a::banach"
  assumes "f integrable_on (closed_segment a b)"
    and "g integrable_on (closed_segment a b)"
    and "x. x  closed_segment a b  norm (f x)  g x"
  shows "norm (ivl_integral a b f)  abs (ivl_integral a b g)"
  using integral_norm_bound_integral[OF assms]
  by (auto simp: ivl_integral_def closed_segment_eq_real_ivl split: if_split_asm)

lemma ivl_integral_norm_bound_integral:
  fixes f :: "real  'a::banach"
  assumes "f integrable_on (closed_segment a b)"
    and "g integrable_on (closed_segment a b)"
    and "x. x  closed_segment a b  norm (f x)  g x"
  shows "norm (ivl_integral a b f)  integral (closed_segment a b) g"
  using integral_norm_bound_integral[OF assms]
  by (auto simp: ivl_integral_def closed_segment_eq_real_ivl split: if_split_asm)

lemma norm_ivl_integral_le:
  fixes f :: "real  real"
  assumes "f integrable_on (closed_segment a b)"
    and "g integrable_on (closed_segment a b)"
    and "x. x  closed_segment a b  f x  g x"
    and "x. x  closed_segment a b  0  f x"
  shows "abs (ivl_integral a b f)  abs (ivl_integral a b g)"
proof (cases "a = b")
  case True then show ?thesis
    by simp
next
  case False
  have "0  integral {a..b} f" "0  integral {b..a} f"
    by (metis le_cases Henstock_Kurzweil_Integration.integral_nonneg assms(1) assms(4) closed_segment_eq_real_ivl integral_emptyI(1))+
  then show ?thesis
    using integral_le[OF assms(1-3)]
    unfolding ivl_integral_def closed_segment_eq_real_ivl
    by (simp split: if_split_asm)
qed

lemma ivl_integral_const [simp]:
  shows "ivl_integral a b (λx. c) = (b - a) *R c"
  by (auto simp: ivl_integral_def algebra_simps)

lemma ivl_integral_has_vector_derivative:
  fixes f :: "real  'a::banach"
  assumes "continuous_on (closed_segment a b) f"
    and "x  closed_segment a b"
  shows "((λu. ivl_integral a u f) has_vector_derivative f x) (at x within closed_segment a b)"
proof -
  have "((λx. integral {x..a} f) has_vector_derivative 0) (at x within {a..b})" if "a  x" "x  b"
    by (rule has_vector_derivative_transform) (auto simp: that)
  moreover
  have "((λx. integral {a..x} f) has_vector_derivative 0) (at x within {b..a})" if "b  x" "x  a"
    by (rule has_vector_derivative_transform) (auto simp: that)
  ultimately
  show ?thesis
    using assms
    by (auto simp: ivl_integral_def closed_segment_eq_real_ivl
        intro!: derivative_eq_intros
        integral_has_vector_derivative[of a b f] integral_has_vector_derivative[of b a "-f"]
        integral_has_vector_derivative'[of b a f])
qed

lemma ivl_integral_has_vderiv_on:
  fixes f :: "real  'a::banach"
  assumes "continuous_on (closed_segment a b) f"
  shows "((λu. ivl_integral a u f) has_vderiv_on f) (closed_segment a b)"
  using ivl_integral_has_vector_derivative[OF assms]
  by (auto simp: has_vderiv_on_def)

lemma ivl_integral_has_vderiv_on_subset_segment:
  fixes f :: "real  'a::banach"
  assumes "continuous_on (closed_segment a b) f"
    and "c  closed_segment a b"
  shows "((λu. ivl_integral c u f) has_vderiv_on f) (closed_segment a b)"
proof -
  have "(closed_segment c a)  (closed_segment a b)" "(closed_segment c b)  (closed_segment a b)"
    using assms by (auto simp: closed_segment_eq_real_ivl split: if_splits)
  then have "((λu. ivl_integral c u f) has_vderiv_on f) ((closed_segment c a)  (closed_segment c b))"
    by (auto intro!: has_vderiv_on_union_closed ivl_integral_has_vderiv_on assms
      intro: continuous_on_subset)
  also have "(closed_segment c a)  (closed_segment c b) = (closed_segment a b)"
    using assms by (auto simp: closed_segment_eq_real_ivl split: if_splits)
  finally show ?thesis .
qed

lemma ivl_integral_has_vector_derivative_subset:
  fixes f :: "real  'a::banach"
  assumes "continuous_on (closed_segment a b) f"
    and "x  closed_segment a b"
    and "c  closed_segment a b"
  shows "((λu. ivl_integral c u f) has_vector_derivative f x) (at x within closed_segment a b)"
  using ivl_integral_has_vderiv_on_subset_segment[OF assms(1)] assms(2-)
  by (auto simp: has_vderiv_on_def)

lemma
  compact_interval_eq_Inf_Sup:
  fixes A::"real set"
  assumes "is_interval A" "compact A" "A  {}"
  shows "A = {Inf A .. Sup A}"
  apply (auto simp: closed_segment_eq_real_ivl
      intro!: cInf_lower cSup_upper bounded_imp_bdd_below bounded_imp_bdd_above
      compact_imp_bounded assms)
  by (metis assms(1) assms(2) assms(3) cInf_eq_minimum cSup_eq_maximum compact_attains_inf
      compact_attains_sup mem_is_interval_1_I)

lemma ivl_integral_has_vderiv_on_compact_interval:
  fixes f :: "real  'a::banach"
  assumes "continuous_on A f"
    and "c  A" "is_interval A" "compact A"
  shows "((λu. ivl_integral c u f) has_vderiv_on f) A"
proof -
  have "A = {Inf A .. Sup A}"
    by (rule compact_interval_eq_Inf_Sup) (use assms in auto)
  also have " = closed_segment (Inf A) (Sup A)" using assms
    by (auto simp add: closed_segment_eq_real_ivl
        intro!: cInf_le_cSup bounded_imp_bdd_below bounded_imp_bdd_above compact_imp_bounded)
  finally have *: "A = closed_segment (Inf A) (Sup A)" .
  show ?thesis
    apply (subst *)
    apply (rule ivl_integral_has_vderiv_on_subset_segment)
    unfolding *[symmetric]
    by fact+
qed

lemma ivl_integral_has_vector_derivative_compact_interval:
  fixes f :: "real  'a::banach"
  assumes "continuous_on A f"
    and "is_interval A" "compact A" "x  A" "c  A"
  shows "((λu. ivl_integral c u f) has_vector_derivative f x) (at x within A)"
  using ivl_integral_has_vderiv_on_compact_interval[OF assms(1)] assms(2-)
  by (auto simp: has_vderiv_on_def)

lemma ivl_integral_combine:
  fixes f::"real  'a::banach"
  assumes "f integrable_on (closed_segment a b)"
  assumes "f integrable_on (closed_segment b c)"
  assumes "f integrable_on (closed_segment a c)"
  shows "ivl_integral a b f + ivl_integral b c f = ivl_integral a c f"
proof -
  show ?thesis
    using assms
      Henstock_Kurzweil_Integration.integral_combine[of a b c f]
      Henstock_Kurzweil_Integration.integral_combine[of a c b f]
      Henstock_Kurzweil_Integration.integral_combine[of b a c f]
      Henstock_Kurzweil_Integration.integral_combine[of b c a f]
      Henstock_Kurzweil_Integration.integral_combine[of c a b f]
      Henstock_Kurzweil_Integration.integral_combine[of c b a f]
    by (cases "a  b"; cases "b  c"; cases "a  c")
       (auto simp: algebra_simps ivl_integral_def closed_segment_eq_real_ivl)
qed

lemma integral_equation_swap_initial_value:
  fixes x::"real'a::banach"
  assumes "t. t  closed_segment t0 t1  x t = x t0 + ivl_integral t0 t (λt. f t (x t))"
  assumes t: "t  closed_segment t0 t1"
  assumes int: "(λt. f t (x t)) integrable_on closed_segment t0 t1"
  shows "x t = x t1 + ivl_integral t1 t (λt. f t (x t))"
proof -
  from t int have "(λt. f t (x t)) integrable_on closed_segment t0 t"
    "(λt. f t (x t)) integrable_on closed_segment t t1"
    by (auto intro: integrable_on_subinterval simp: closed_segment_eq_real_ivl split: if_split_asm)
  with assms(1)[of t] assms(2-)
  have "x t - x t0 = ivl_integral t0 t1 (λt. f t (x t)) + ivl_integral t1 t (λt. f t (x t))"
    by (subst ivl_integral_combine) (auto simp: closed_segment_commute)
  then have "x t + x t1 - (x t0 + ivl_integral t0 t1 (λt. f t (x t))) =
    x t1 + ivl_integral t1 t (λt. f t (x t))"
    by (simp add: algebra_simps)
  also have "x t0 + ivl_integral t0 t1 (λt. f t (x t)) = x t1"
    by (auto simp: assms(1)[symmetric])
  finally show ?thesis  by simp
qed

lemma has_integral_nonpos:
  fixes f :: "'n::euclidean_space  real"
  assumes "(f has_integral i) s"
    and "xs. f x  0"
  shows "i  0"
  by (rule has_integral_nonneg[of "-f" "-i" s, simplified])
    (auto intro!: has_integral_neg simp: fun_Compl_def assms)

lemma has_ivl_integral_nonneg:
  fixes f :: "real  real"
  assumes "(f has_ivl_integral i) a b"
    and "x. a  x  x  b  0  f x"
    and "x. b  x  x  a  f x  0"
  shows "0  i"
  using assms has_integral_nonneg[of f i "{a .. b}"] has_integral_nonpos[of f "-i" "{b .. a}"]
  by (auto simp: has_ivl_integral_def Ball_def not_le split: if_split_asm)

lemma has_ivl_integral_ivl_integral:
  "f integrable_on (closed_segment a b)  (f has_ivl_integral (ivl_integral a b f)) a b"
  by (auto simp: closed_segment_eq_real_ivl has_ivl_integral_def ivl_integral_def)

lemma ivl_integral_nonneg:
  fixes f :: "real  real"
  assumes "f integrable_on (closed_segment a b)"
    and "x. a  x  x  b  0  f x"
    and "x. b  x  x  a  f x  0"
  shows "0  ivl_integral a b f"
  by (rule has_ivl_integral_nonneg[OF assms(1)[unfolded has_ivl_integral_ivl_integral] assms(2-3)])

lemma ivl_integral_bound:
  fixes f::"real  'a::banach"
  assumes "continuous_on (closed_segment a b) f"
  assumes "t. t  (closed_segment a b)  norm (f t)  B"
  shows "norm (ivl_integral a b f)  B * abs (b - a)"
  using integral_bound[of a b f B]
    integral_bound[of b a f B]
    assms
  by (auto simp: closed_segment_eq_real_ivl has_ivl_integral_def ivl_integral_def split: if_splits)

lemma ivl_integral_minus_sets:
  fixes f::"real  'a::banach"
  shows "f integrable_on (closed_segment c a)  f integrable_on (closed_segment c b)  f integrable_on (closed_segment a b) 
    ivl_integral c a f - ivl_integral c b f = ivl_integral b a f"
  using ivl_integral_combine[of f c b a]
  by (auto simp: algebra_simps closed_segment_commute)

lemma ivl_integral_minus_sets':
  fixes f::"real  'a::banach"
  shows "f integrable_on (closed_segment a c)  f integrable_on (closed_segment b c)  f integrable_on (closed_segment a b) 
    ivl_integral a c f - ivl_integral b c f = ivl_integral a b f"
  using ivl_integral_combine[of f a b c]
  by (auto simp: algebra_simps closed_segment_commute)

end

Theory Gronwall

theory Gronwall
imports Vector_Derivative_On
begin

subsection ‹Gronwall›

lemma derivative_quotient_bound:
  assumes g_deriv_on: "(g has_vderiv_on g') {a .. b}"
  assumes frac_le: "t. t  {a .. b}  g' t / g t  K"
  assumes g'_cont: "continuous_on {a .. b} g'"
  assumes g_pos: "t. t  {a .. b}  g t > 0"
  assumes t_in: "t  {a .. b}"
  shows "g t  g a * exp (K * (t - a))"
proof -
  have g_deriv: "t. t  {a .. b}  (g has_real_derivative g' t) (at t within {a .. b})"
    using g_deriv_on
    by (auto simp: has_vderiv_on_def has_field_derivative_iff_has_vector_derivative[symmetric])
  from assms have g_nonzero: "t. t  {a .. b}  g t  0"
    by fastforce
  have frac_integrable: "t. t  {a .. b}  (λt. g' t / g t) integrable_on {a..t}"
    by (force simp: g_nonzero intro: assms has_field_derivative_subset[OF g_deriv]
      continuous_on_subset[OF g'_cont] continuous_intros integrable_continuous_real
      continuous_on_subset[OF vderiv_on_continuous_on[OF g_deriv_on]])
  have "t. t  {a..b}  ((λt. g' t / g t) has_integral ln (g t) - ln (g a)) {a .. t}"
    by (rule fundamental_theorem_of_calculus)
      (auto intro!: derivative_eq_intros assms has_field_derivative_subset[OF g_deriv]
        simp: has_field_derivative_iff_has_vector_derivative[symmetric])
  hence *: "t. t  {a .. b}  ln (g t) - ln (g a) = integral {a .. t} (λt. g' t / g t)"
    using integrable_integral[OF frac_integrable]
    by (rule has_integral_unique[where f = "λt. g' t / g t"])
  from * t_in have "ln (g t) - ln (g a) = integral {a .. t} (λt. g' t / g t)" .
  also have "  integral {a .. t} (λ_. K)"
    using t  {a .. b}
    by (intro integral_le) (auto intro!: frac_integrable frac_le integral_le)
  also have " = K * (t - a)" using t  {a .. b}
    by simp
  finally have "ln (g t)  K * (t - a) + ln (g a)" (is "?lhs  ?rhs")
    by simp
  hence "exp ?lhs  exp ?rhs"
    by simp
  thus ?thesis
    using t  {a .. b} g_pos
    by (simp add: ac_simps exp_add del: exp_le_cancel_iff)
qed

lemma derivative_quotient_bound_left:
  assumes g_deriv_on: "(g has_vderiv_on g') {a .. b}"
  assumes frac_ge: "t. t  {a .. b}  K  g' t / g t"
  assumes g'_cont: "continuous_on {a .. b} g'"
  assumes g_pos: "t. t  {a .. b}  g t > 0"
  assumes t_in: "t  {a..b}"
  shows "g t  g b * exp (K * (t - b))"
proof -
  have g_deriv: "t. t  {a .. b}  (g has_real_derivative g' t) (at t within {a .. b})"
    using g_deriv_on
    by (auto simp: has_vderiv_on_def has_field_derivative_iff_has_vector_derivative[symmetric])
  from assms have g_nonzero: "t. t  {a..b}  g t  0"
    by fastforce
  have frac_integrable: "t. t  {a .. b}  (λt. g' t / g t) integrable_on {t..b}"
    by (force simp: g_nonzero intro: assms has_field_derivative_subset[OF g_deriv]
      continuous_on_subset[OF g'_cont] continuous_intros integrable_continuous_real
      continuous_on_subset[OF vderiv_on_continuous_on[OF g_deriv_on]])
  have "t. t  {a..b}  ((λt. g' t / g t) has_integral ln (g b) - ln (g t)) {t..b}"
    by (rule fundamental_theorem_of_calculus)
      (auto intro!: derivative_eq_intros assms has_field_derivative_subset[OF g_deriv]
        simp: has_field_derivative_iff_has_vector_derivative[symmetric])
  hence *: "t. t  {a..b}  ln (g b) - ln (g t) = integral {t..b} (λt. g' t / g t)"
    using integrable_integral[OF frac_integrable]
    by (rule has_integral_unique[where f = "λt. g' t / g t"])
  have "K * (b - t) = integral {t..b} (λ_. K)"
    using t  {a..b}
    by simp
  also have "...  integral {t..b} (λt. g' t / g t)"
    using t  {a..b}
    by (intro integral_le) (auto intro!: frac_integrable frac_ge integral_le)
  also have "... = ln (g b) - ln (g t)"
    using * t_in by simp
  finally have "K * (b - t) + ln (g t)  ln (g b)" (is "?lhs  ?rhs")
    by simp
  hence "exp ?lhs  exp ?rhs"
    by simp
  hence "g t * exp (K * (b - t))  g b"
    using t  {a..b} g_pos
    by (simp add: ac_simps exp_add del: exp_le_cancel_iff)
  hence "g t / exp (K * (t - b))  g b"
    by (simp add: algebra_simps exp_diff)
  thus ?thesis
    by (simp add: field_simps)
qed

lemma gronwall_general:
  fixes g K C a b and t::real
  defines "G  λt. C + K * integral {a..t} (λs. g s)"
  assumes g_le_G: "t. t  {a..b}  g t  G t"
  assumes g_cont: "continuous_on {a..b} g"
  assumes g_nonneg: "t. t  {a..b}  0  g t"
  assumes pos: "0 < C" "K > 0"
  assumes "t  {a..b}"
  shows "g t  C * exp (K * (t - a))"
proof -
  have G_pos: "t. t  {a..b}  0 < G t"
    by (auto simp: G_def intro!: add_pos_nonneg mult_nonneg_nonneg Henstock_Kurzweil_Integration.integral_nonneg
      integrable_continuous_real assms intro: less_imp_le continuous_on_subset)
  have "g t  G t" using assms by auto
  also
  {
    have "(G has_vderiv_on (λt. K * g t)) {a..b}"
      by (auto intro!: derivative_eq_intros integral_has_vector_derivative g_cont
        simp add: G_def has_vderiv_on_def)
    moreover
    {
      fix t assume "t  {a..b}"
      hence "K * g t / G t  K * G t / G t"
        using pos g_le_G G_pos
        by (intro divide_right_mono mult_left_mono) (auto intro!: less_imp_le)
      also have " = K"
        using G_pos[of t] t  {a .. b} by simp
      finally have "K * g t / G t  K" .
    }
    ultimately have "G t  G a * exp (K * (t - a))"
      apply (rule derivative_quotient_bound)
      using t  {a..b}
      by (auto intro!: continuous_intros g_cont G_pos simp: field_simps pos)
  }
  also have "G a = C"
    by (simp add: G_def)
  finally show ?thesis
    by simp
qed

lemma gronwall_general_left:
  fixes g K C a b and t::real
  defines "G  λt. C + K * integral {t..b} (λs. g s)"
  assumes g_le_G: "t. t  {a..b}  g t  G t"
  assumes g_cont: "continuous_on {a..b} g"
  assumes g_nonneg: "t. t  {a..b}  0  g t"
  assumes pos: "0 < C" "K > 0"
  assumes "t  {a..b}"
  shows "g t  C * exp (-K * (t - b))"
proof -
  have G_pos: "t. t  {a..b}  0 < G t"
    by (auto simp: G_def intro!: add_pos_nonneg mult_nonneg_nonneg Henstock_Kurzweil_Integration.integral_nonneg
      integrable_continuous_real assms intro: less_imp_le continuous_on_subset)
  have "g t  G t" using assms by auto
  also
  {
    have "(G has_vderiv_on (λt. -K * g t)) {a..b}"
      by (auto intro!: derivative_eq_intros g_cont integral_has_vector_derivative'
          simp add: G_def has_vderiv_on_def)
    moreover
    {
      fix t assume "t  {a..b}"
      hence "K * g t / G t  K * G t / G t"
        using pos g_le_G G_pos
        by (intro divide_right_mono mult_left_mono) (auto intro!: less_imp_le)
      also have " = K"
        using G_pos[of t] t  {a .. b} by simp
      finally have "K * g t / G t  K" .
      hence "-K  -K * g t / G t"
        by simp
    }
    ultimately
    have "G t  G b * exp (-K * (t - b))"
      apply (rule derivative_quotient_bound_left)
      using t  {a..b}
      by (auto intro!: continuous_intros g_cont G_pos simp: field_simps pos)
  }
  also have "G b = C"
    by (simp add: G_def)
  finally show ?thesis
    by simp
qed

lemma gronwall_general_segment:
  fixes a b::real
  assumes "t. t  closed_segment a b  g t  C + K * integral (closed_segment a t) g"
    and "continuous_on (closed_segment a b) g"
    and "t. t  closed_segment a b  0  g t"
    and "0 < C"
    and "0 < K"
    and "t  closed_segment a b"
  shows "g t  C * exp (K * abs (t - a))"
proof cases
  assume "a  b"
  then have *: "abs (t - a) = t -a" using assms by (auto simp: closed_segment_eq_real_ivl)
  show ?thesis
    unfolding *
    using assms
    by (intro gronwall_general[where b=b]) (auto intro!: simp: closed_segment_eq_real_ivl a  b)
next
  assume "¬a  b"
  then have *: "K * abs (t - a) = - K * (t - a)" using assms by (auto simp: closed_segment_eq_real_ivl algebra_simps)
  {
    fix s :: real
    assume a1: "b  s"
    assume a2: "s  a"
    assume a3: "t. b  t  t  a  g t  C + K * integral (if a  t then {a..t} else {t..a}) g"
    have "s = a  s < a"
      using a2 by (meson less_eq_real_def)
    then have "g s  C + K * integral {s..a} g"
      using a3 a1 by fastforce
  } then show ?thesis
    unfolding *
    using assms  ¬a  b
    by (intro gronwall_general_left)
      (auto intro!: simp: closed_segment_eq_real_ivl)
qed

lemma gronwall_more_general_segment:
  fixes a b c::real
  assumes "t. t  closed_segment a b  g t  C + K * integral (closed_segment c t) g"
    and cont: "continuous_on (closed_segment a b) g"
    and "t. t  closed_segment a b  0  g t"
    and "0 < C"
    and "0 < K"
    and t: "t  closed_segment a b"
    and c: "c  closed_segment a b"
  shows "g t  C * exp (K * abs (t - c))"
proof -
  from t c have "t  closed_segment c a  t  closed_segment c b"
    by (auto simp: closed_segment_eq_real_ivl split_ifs)
  then show ?thesis
  proof
    assume "t  closed_segment c a"
    moreover
    have subs: "closed_segment c a  closed_segment a b" using t c
      by (auto simp: closed_segment_eq_real_ivl split_ifs)
    ultimately show ?thesis
      by (intro gronwall_general_segment[where b=a])
        (auto intro!: assms intro: continuous_on_subset)
  next
    assume "t  closed_segment c b"
    moreover
    have subs: "closed_segment c b  closed_segment a b" using t c
      by (auto simp: closed_segment_eq_real_ivl)
    ultimately show ?thesis
      by (intro gronwall_general_segment[where b=b])
        (auto intro!: assms intro: continuous_on_subset)
  qed
qed

lemma gronwall:
  fixes g K C and t::real
  defines "G  λt. C + K * integral {0..t} (λs. g s)"
  assumes g_le_G: "t. 0  t  t  a  g t  G t"
  assumes g_cont: "continuous_on {0..a} g"
  assumes g_nonneg: "t. 0  t  t  a  0  g t"
  assumes pos: "0 < C" "0 < K"
  assumes "0  t" "t  a"
  shows "g t  C * exp (K * t)"
  apply(rule gronwall_general[where a=0, simplified, OF assms(2-6)[unfolded G_def]])
  using assms(7,8)
  by simp_all

lemma gronwall_left:
  fixes g K C and t::real
  defines "G  λt. C + K * integral {t..0} (λs. g s)"
  assumes g_le_G: "t. a  t  t  0  g t  G t"
  assumes g_cont: "continuous_on {a..0} g"
  assumes g_nonneg: "t. a  t  t  0  0  g t"
  assumes pos: "0 < C" "0 < K"
  assumes "a  t" "t  0"
  shows "g t  C * exp (-K * t)"
  apply(simp, rule gronwall_general_left[where b=0, simplified, OF assms(2-6)[unfolded G_def]])
  using assms(7,8)
  by simp_all

end

Theory Initial_Value_Problem

section‹Initial Value Problems›
theory Initial_Value_Problem
  imports
    "../ODE_Auxiliarities"
    "../Library/Interval_Integral_HK"
    "../Library/Gronwall"
begin

lemma clamp_le[simp]: "x  a  clamp a b x = a" for x::"'a::ordered_euclidean_space"
  by (auto simp: clamp_def eucl_le[where 'a='a] intro!: euclidean_eqI[where 'a='a])

lemma clamp_ge[simp]: "a  b  b  x  clamp a b x = b" for x::"'a::ordered_euclidean_space"
  by (force simp: clamp_def eucl_le[where 'a='a] not_le not_less  intro!: euclidean_eqI[where 'a='a])

abbreviation cfuncset :: "'a::topological_space set  'b::metric_space set  ('a C 'b) set"
  (infixr "C" 60)
  where "A C B  PiC A (λ_. B)"

lemma closed_segment_translation_zero: "z  {z + a--z + b}  0  {a -- b}"
  by (metis add.right_neutral closed_segment_translation_eq)

lemma closed_segment_subset_interval: "is_interval T  a  T  b  T  closed_segment a b  T"
  by (rule closed_segment_subset) (auto intro!: closed_segment_subset is_interval_convex)

definition half_open_segment::"'a::real_vector  'a  'a set" ("(1{_--<_})")
  where "half_open_segment a b = {a -- b} - {b}"

lemma half_open_segment_real:
  fixes a b::real
  shows "{a --< b} = (if a  b then {a ..< b} else {b <.. a})"
  by (auto simp: half_open_segment_def closed_segment_eq_real_ivl)

lemma closure_half_open_segment:
  fixes a b::real
  shows "closure {a --< b} = (if a = b then {} else {a -- b})"
  unfolding closed_segment_eq_real_ivl if_distrib half_open_segment_real
  unfolding if_distribR
  by simp

lemma half_open_segment_subset[intro, simp]:
  "{t0--<t1}  {t0 -- t1}"
  "x  {t0--<t1}  x  {t0 -- t1}"
  by (auto simp: half_open_segment_def)

lemma half_open_segment_closed_segmentI:
  "t  {t0 -- t1}  t  t1  t  {t0 --< t1}"
  by (auto simp: half_open_segment_def)

lemma islimpt_half_open_segment:
  fixes t0 t1 s::real
  assumes "t0  t1" "s  {t0--t1}"
  shows "s islimpt {t0--<t1}"
proof -
  have "s islimpt {t0..<t1}" if "t0  s" "s  t1" for s
  proof -
    have *: "{t0..<t1} - {s} = {t0..<s}  {s<..<t1}"
      using that by auto
    show ?thesis
      using that t0  t1 *
      by (cases "t0 = s") (auto simp: islimpt_in_closure)
  qed
  moreover have "s islimpt {t1<..t0}" if "t1  s" "s  t0" for s
  proof -
    have *: "{t1<..t0} - {s} = {t1<..<s}  {s<..t0}"
      using that by auto
    show ?thesis
      using that t0  t1 *
      by (cases "t0 = s") (auto simp: islimpt_in_closure)
  qed
  ultimately show ?thesis using assms
    by (auto simp: half_open_segment_real closed_segment_eq_real_ivl)
qed

lemma
  mem_half_open_segment_eventually_in_closed_segment:
  fixes t::real
  assumes "t  {t0--<t1'}"
  shows "F t1' in at t1' within {t0--<t1'}. t  {t0--t1'}"
  unfolding half_open_segment_real
proof (split if_split, safe)
  assume le: "t0  t1'"
  with assms have t: "t0  t" "t < t1'"
    by (auto simp: half_open_segment_real)
  then have "F t1' in at t1' within {t0..<t1'}. t0  t"
    by simp
  moreover
  from tendsto_ident_at t < t1'
  have "F t1' in at t1' within {t0..<t1'}. t < t1'"
    by (rule order_tendstoD)
  ultimately show "F t1' in at t1' within {t0..<t1'}. t  {t0--t1'}"
    by eventually_elim (auto simp add: closed_segment_eq_real_ivl)
next
  assume le: "¬ t0  t1'"
  with assms have t: "t  t0" "t1' < t"
    by (auto simp: half_open_segment_real)
  then have "F t1' in at t1' within {t1'<..t0}. t  t0"
    by simp
  moreover
  from tendsto_ident_at t1' < t
  have "F t1' in at t1' within {t1'<..t0}. t1' < t"
    by (rule order_tendstoD)
  ultimately show "F t1' in at t1' within {t1'<..t0}. t  {t0--t1'}"
    by eventually_elim (auto simp add: closed_segment_eq_real_ivl)
qed

lemma closed_segment_half_open_segment_subsetI:
  fixes x::real shows "x  {t0--<t1}  {t0--x}  {t0--<t1}"
  by (auto simp: half_open_segment_real closed_segment_eq_real_ivl split: if_split_asm)

lemma dist_component_le:
  fixes x y::"'a::euclidean_space"
  assumes "i  Basis"
  shows "dist (x  i) (y  i)  dist x y"
  using assms
  by (auto simp: euclidean_dist_l2[of x y] intro: member_le_L2_set)

lemma sum_inner_Basis_one: "i  Basis  (xBasis. x  i) = 1"
  by (subst sum.mono_neutral_right[where S="{i}"])
    (auto simp: inner_not_same_Basis)

lemma cball_in_cbox:
  fixes y::"'a::euclidean_space"
  shows "cball y r  cbox (y - r *R One) (y + r *R One)"
  unfolding scaleR_sum_right interval_cbox cbox_def
proof safe
  fix x i::'a assume "i  Basis" "x  cball y r"
  with dist_component_le[OF i  Basis›, of y x]
  have "dist (y  i) (x  i)  r" by (simp add: mem_cball)
  thus "(y - sum ((*R) r) Basis)  i  x  i"
    "x  i  (y + sum ((*R) r) Basis)  i"
    by (auto simp add: inner_diff_left inner_add_left inner_sum_left
      sum_distrib_left[symmetric] sum_inner_Basis_one iBasis› dist_real_def)
qed

lemma centered_cbox_in_cball:
  shows "cbox (- r *R One) (r *R One::'a::euclidean_space) 
    cball 0 (sqrt(DIM('a)) * r)"
proof
  fix x::'a
  have "norm x  sqrt(DIM('a)) * infnorm x"
  by (rule norm_le_infnorm)
  also
  assume "x  cbox (- r *R One) (r *R One)"
  hence "infnorm x  r"
    by (auto simp: infnorm_def mem_box intro!: cSup_least)
  finally show "x  cball 0 (sqrt(DIM('a)) * r)"
    by (auto simp: dist_norm mult_left_mono mem_cball)
qed


subsection ‹Solutions of IVPs \label{sec:solutions}›

definition
  solves_ode :: "(real  'a::real_normed_vector)  (real  'a  'a)  real set  'a set  bool"
  (infix "(solves'_ode)" 50)
where
  "(y solves_ode f) T X  (y has_vderiv_on (λt. f t (y t))) T  y  T  X"

lemma solves_odeI:
  assumes solves_ode_vderivD: "(y has_vderiv_on (λt. f t (y t))) T"
    and solves_ode_domainD: "t. t  T  y t  X"
  shows "(y solves_ode f) T X"
  using assms
  by (auto simp: solves_ode_def)

lemma solves_odeD:
  assumes "(y solves_ode f) T X"
  shows solves_ode_vderivD: "(y has_vderiv_on (λt. f t (y t))) T"
    and solves_ode_domainD: "t. t  T  y t  X"
  using assms
  by (auto simp: solves_ode_def)

lemma solves_ode_continuous_on: "(y solves_ode f) T X  continuous_on T y"
  by (auto intro!: vderiv_on_continuous_on simp: solves_ode_def)

lemma solves_ode_congI:
  assumes "(x solves_ode f) T X"
  assumes "t. t  T  x t = y t"
  assumes "t. t  T  f t (x t) = g t (x t)"
  assumes "T = S" "X = Y"
  shows "(y solves_ode g) S Y"
  using assms
  by (auto simp: solves_ode_def Pi_iff)

lemma solves_ode_cong[cong]:
  assumes "t. t  T  x t = y t"
  assumes "t. t  T  f t (x t) = g t (x t)"
  assumes "T = S" "X = Y"
  shows "(x solves_ode f) T X  (y solves_ode g) S Y"
  using assms
  by (auto simp: solves_ode_def Pi_iff)

lemma solves_ode_on_subset:
  assumes "(x solves_ode f) S Y"
  assumes "T  S" "Y  X"
  shows "(x solves_ode f) T X"
  using assms
  by (auto simp: solves_ode_def has_vderiv_on_subset)

lemma preflect_solution:
  assumes "t0  T"
  assumes sol: "((λt. x (preflect t0 t)) solves_ode (λt x. - f (preflect t0 t) x)) (preflect t0 ` T) X"
  shows "(x solves_ode f) T X"
proof (rule solves_odeI)
  from solves_odeD[OF sol]
  have xm_deriv: "(x o preflect t0 has_vderiv_on (λt. - f (preflect t0 t) (x (preflect t0 t)))) (preflect t0 ` T)"
    and xm_mem: "t  preflect t0 ` T  x (preflect t0 t)  X" for t
    by simp_all
  have "(x o preflect t0 o preflect t0 has_vderiv_on (λt. f t (x t))) T"
    apply (rule has_vderiv_on_eq_rhs)
    apply (rule has_vderiv_on_compose)
    apply (rule xm_deriv)
    apply (auto simp: preflect_def intro!: derivative_intros)
    done
  then show "(x has_vderiv_on (λt. f t (x t))) T"
    by (simp add: preflect_def)
  show "x t  X" if "t  T" for t
    using that xm_mem[of "preflect t0 t"]
    by (auto simp: preflect_def)
qed

lemma solution_preflect:
  assumes "t0  T"
  assumes sol: "(x solves_ode f) T X"
  shows "((λt. x (preflect t0 t)) solves_ode (λt x. - f (preflect t0 t) x)) (preflect t0 ` T) X"
  using sol t0  T
  by (simp_all add: preflect_def image_image preflect_solution[of t0])

lemma solution_eq_preflect_solution:
  assumes "t0  T"
  shows "(x solves_ode f) T X  ((λt. x (preflect t0 t)) solves_ode (λt x. - f (preflect t0 t) x)) (preflect t0 ` T) X"
  using solution_preflect[OF t0  T] preflect_solution[OF t0  T]
  by blast

lemma shift_autonomous_solution:
  assumes sol: "(x solves_ode f) T X"
  assumes auto: "s t. s  T  f s (x s) = f t (x s)"
  shows "((λt. x (t + t0)) solves_ode f) ((λt. t - t0) ` T) X"
  using solves_odeD[OF sol]
  apply (intro solves_odeI)
  apply (rule has_vderiv_on_compose'[of x, THEN has_vderiv_on_eq_rhs])
  apply (auto simp: image_image intro!: auto derivative_intros)
  done

lemma solves_ode_singleton: "y t0  X  (y solves_ode f) {t0} X"
  by (auto intro!: solves_odeI has_vderiv_on_singleton)

subsubsection‹Connecting solutions›
text‹\label{sec:combining-solutions}›

lemma connection_solves_ode:
  assumes x: "(x solves_ode f) T X"
  assumes y: "(y solves_ode g) S Y"
  assumes conn_T: "closure S  closure T  T"
  assumes conn_S: "closure S  closure T  S"
  assumes conn_x: "t. t  closure S  t  closure T  x t = y t"
  assumes conn_f: "t. t  closure S  t  closure T  f t (y t) = g t (y t)"
  shows "((λt. if t  T then x t else y t) solves_ode (λt. if t  T then f t else g t)) (T  S) (X  Y)"
proof (rule solves_odeI)
  from solves_odeD(2)[OF x] solves_odeD(2)[OF y]
  show "t  T  S  (if t  T then x t else y t)  X  Y" for t
    by auto
  show "((λt. if t  T then x t else y t) has_vderiv_on (λt. (if t  T then f t else g t) (if t  T then x t else y t))) (T  S)"
    apply (rule has_vderiv_on_If[OF refl, THEN has_vderiv_on_eq_rhs])
    unfolding Un_absorb2[OF conn_T] Un_absorb2[OF conn_S]
    apply (rule solves_odeD(1)[OF x])
    apply (rule solves_odeD(1)[OF y])
    apply (simp_all add: conn_T conn_S Un_absorb2 conn_x conn_f)
    done
qed

lemma
  solves_ode_subset_range:
  assumes x: "(x solves_ode f) T X"
  assumes s: "x ` T  Y"
  shows "(x solves_ode f) T Y"
  using assms
  by (auto intro!: solves_odeI dest!: solves_odeD)


subsection ‹unique solution with initial value›

definition
  usolves_ode_from :: "(real  'a::real_normed_vector)  (real  'a  'a)  real  real set  'a set  bool"
  ("((_) usolves'_ode (_) from (_))" [10, 10, 10] 10)
  ― ‹TODO: no idea about mixfix and precedences, check this!›
where
  "(y usolves_ode f from t0) T X  (y solves_ode f) T X  t0  T  is_interval T 
    (z T'. t0  T'  is_interval T'  T'  T  (z solves_ode f) T' X  z t0 = y t0  (t  T'. z t = y t))"

text ‹uniqueness of solution can depend on domain X›:›

lemma
  "((λ_. 0::real) usolves_ode (λ_. sqrt) from 0) {0..} {0}"
    "((λt. t2 / 4) solves_ode (λ_. sqrt)) {0..} {0..}"
    "(λt. t2 / 4) 0 = (λ_. 0::real) 0"
  by (auto intro!: derivative_eq_intros
    simp: has_vderiv_on_def has_vector_derivative_def usolves_ode_from_def solves_ode_def
      is_interval_ci real_sqrt_divide)

text ‹TODO: show that if solution stays in interior, then domain can be enlarged! (?)›

lemma usolves_odeD:
  assumes "(y usolves_ode f from t0) T X"
  shows "(y solves_ode f) T X"
    and "t0  T"
    and "is_interval T"
    and "z T' t. t0  T'  is_interval T'  T'  T (z solves_ode f) T' X  z t0 = y t0  t  T'  z t = y t"
  using assms
  unfolding usolves_ode_from_def
  by blast+

lemma usolves_ode_rawI:
  assumes "(y solves_ode f) T X" "t0  T" "is_interval T"
  assumes "z T' t. t0  T'  is_interval T'  T'  T  (z solves_ode f) T' X  z t0 = y t0  t  T'  z t = y t"
  shows "(y usolves_ode f from t0) T X"
  using assms
  unfolding usolves_ode_from_def
  by blast

lemma usolves_odeI:
  assumes "(y solves_ode f) T X" "t0  T" "is_interval T"
  assumes usol: "z t. {t0 -- t}  T  (z solves_ode f) {t0 -- t} X  z t0 = y t0  z t = y t"
  shows "(y usolves_ode f from t0) T X"
proof (rule usolves_ode_rawI; fact?)
  fix z T' t
  assume T': "t0  T'" "is_interval T'" "T'  T"
    and z: "(z solves_ode f) T' X" and iv: "z t0 = y t0" and t: "t  T'"
  have subset_T': "{t0 -- t}  T'"
    by (rule closed_segment_subset_interval; fact)
  with z have sol_cs: "(z solves_ode f) {t0 -- t} X"
    by (rule solves_ode_on_subset[OF _ _ order_refl])
  from subset_T' have subset_T: "{t0 -- t}  T"
    using T'  T by simp
  from usol[OF subset_T sol_cs iv]
  show "z t = y t" by simp
qed

lemma is_interval_singleton[intro,simp]: "is_interval {t0}"
  by (auto simp: is_interval_def intro!: euclidean_eqI[where 'a='a])

lemma usolves_ode_singleton: "x t0  X  (x usolves_ode f from t0) {t0} X"
  by (auto intro!: usolves_odeI solves_ode_singleton)

lemma usolves_ode_congI:
  assumes x: "(x usolves_ode f from t0) T X"
  assumes "t. t  T  x t = y t"
  assumes "t y. t  T  y  X  f t y = g t y"― ‹TODO: weaken this assumption?!›
  assumes "t0 = s0"
  assumes "T = S"
  assumes "X = Y"
  shows "(y usolves_ode g from s0) S Y"
proof (rule usolves_ode_rawI)
  from assms x have "(y solves_ode f) S Y"
    by (auto simp add: usolves_ode_from_def)
  then show "(y solves_ode g) S Y"
    by (rule solves_ode_congI) (use assms in auto simp: usolves_ode_from_def dest!: solves_ode_domainD›)
  from assms show "s0  S" "is_interval S"
    by (auto simp add: usolves_ode_from_def)
next
  fix z T' t
  assume hyps: "s0  T'" "is_interval T'" "T'  S" "(z solves_ode g) T' Y" "z s0 = y s0" "t  T'"
  from (z solves_ode g) T' Y
  have zsol: "(z solves_ode f) T' Y"
    by (rule solves_ode_congI) (use assms hyps in auto dest!: solves_ode_domainD›)
  have "z t = x t"
    by (rule x[THEN usolves_odeD(4),where T' = T'])
      (use zsol s0  T' ‹is_interval T' T'  S T = S z s0 = y s0 t  T' assms in auto)
  also have "y t = x t" using assms t  T' T'  S T = S by auto
  finally show "z t = y t" by simp
qed


lemma usolves_ode_cong[cong]:
  assumes "t. t  T  x t = y t"
  assumes "t y. t  T  y  X  f t y = g t y"― ‹TODO: weaken this assumption?!›
  assumes "t0 = s0"
  assumes "T = S"
  assumes "X = Y"
  shows "(x usolves_ode f from t0) T X  (y usolves_ode g from s0) S Y"
  apply (rule iffI)
  subgoal by (rule usolves_ode_congI[OF _ assms]; assumption)
  subgoal by (metis assms(1) assms(2) assms(3) assms(4) assms(5) usolves_ode_congI)
  done

lemma shift_autonomous_unique_solution:
  assumes usol: "(x usolves_ode f from t0) T X"
  assumes auto: "s t x. x  X  f s x = f t x"
  shows "((λt. x (t + t0 - t1)) usolves_ode f from t1) ((+) (t1 - t0) ` T) X"
proof (rule usolves_ode_rawI)
  from usolves_odeD[OF usol]
  have sol: "(x solves_ode f) T X"
    and "t0  T"
    and "is_interval T"
    and unique: "t0  T'  is_interval T'  T'  T  (z solves_ode f) T' X  z t0 = x t0  t  T'  z t = x t"
    for z T' t
    by blast+
  have "(λt. t + t1 - t0) = (+) (t1 - t0)"
    by (auto simp add: algebra_simps)
  with shift_autonomous_solution[OF sol auto, of "t0 - t1"] solves_odeD[OF sol]
  show "((λt. x (t + t0 - t1)) solves_ode f) ((+) (t1 - t0) ` T) X"
    by (simp add: algebra_simps)
  from t0  T show "t1  (+) (t1 - t0) ` T" by auto
  from ‹is_interval T
  show "is_interval ((+) (t1 - t0) ` T)"
    by simp
  fix z T' t
  assume z: "(z solves_ode f) T' X"
    and t0': "t1  T'" "T'  (+) (t1 - t0) ` T"
    and shift: "z t1 = x (t1 + t0 - t1)"
    and t: "t  T'"
    and ivl: "is_interval T'"

  let ?z = "(λt. z (t + (t1 - t0)))"

  have "(?z solves_ode f) ((λt. t - (t1 - t0)) ` T') X"
    apply (rule shift_autonomous_solution[OF z, of "t1 - t0"])
    using solves_odeD[OF z]
    by (auto intro!: auto)
  with _ _ _ have "?z ((t + (t0 - t1))) = x (t + (t0 - t1))"
    apply (rule unique[where z = ?z ])
    using shift t t0' ivl
    by auto
  then show "z t = x (t + t0 - t1)"
    by (simp add: algebra_simps)
qed

lemma three_intervals_lemma:
  fixes a b c::real
  assumes a: "a  A - B"
    and b: "b  B - A"
    and c: "c  A  B"
    and iA: "is_interval A" and iB: "is_interval B"
    and aI: "a  I"
    and bI: "b  I"
    and iI: "is_interval I"
  shows "c  I"
  apply (rule mem_is_intervalI[OF iI aI bI])
  using iA iB
  apply (auto simp: is_interval_def)
  apply (metis Diff_iff Int_iff a b c le_cases)
  apply (metis Diff_iff Int_iff a b c le_cases)
  done

lemma connection_usolves_ode:
  assumes x: "(x usolves_ode f from tx) T X"
  assumes y: "t. t  closure S  closure T  (y usolves_ode g from t) S X"
  assumes conn_T: "closure S  closure T  T"
  assumes conn_S: "closure S  closure T  S"
  assumes conn_t: "t  closure S  closure T"
  assumes conn_x: "t. t  closure S  t  closure T  x t = y t"
  assumes conn_f: "t x. t  closure S  t  closure T  x  X  f t x = g t x"
  shows "((λt. if t  T then x t else y t) usolves_ode (λt. if t  T then f t else g t) from tx) (T  S) X"
  apply (rule usolves_ode_rawI)
  apply (subst Un_absorb[of X, symmetric])
  apply (rule connection_solves_ode[OF usolves_odeD(1)[OF x] usolves_odeD(1)[OF y[OF conn_t]] conn_T conn_S conn_x conn_f])
  subgoal by assumption
  subgoal by assumption
  subgoal by assumption
  subgoal by assumption
  subgoal using solves_odeD(2)[OF usolves_odeD(1)[OF x]] conn_T by (auto simp add: conn_x[symmetric])
  subgoal using usolves_odeD(2)[OF x] by auto
  subgoal using usolves_odeD(3)[OF x] usolves_odeD(3)[OF y]
    apply (rule is_real_interval_union)
    using conn_T conn_S conn_t by auto
  subgoal premises prems for z TS' s
  proof -
    from (z solves_ode _) _ _
    have "(z solves_ode (λt. if t  T then f t else g t)) (T  TS') X"
      by (rule solves_ode_on_subset) auto
    then have z_f: "(z solves_ode f) (T  TS') X"
      by (subst solves_ode_cong) auto

    from prems(4)
    have "(z solves_ode (λt. if t  T then f t else g t)) (S  TS') X"
      by (rule solves_ode_on_subset) auto
    then have z_g: "(z solves_ode g) (S  TS') X"
      apply (rule solves_ode_congI)
      subgoal by simp
      subgoal by clarsimp (meson closure_subset conn_f contra_subsetD prems(4) solves_ode_domainD)
      subgoal by simp
      subgoal by simp
      done
    have "tx  T" using assms using usolves_odeD(2)[OF x] by auto

    have "z tx = x tx" using assms prems
      by (simp add: tx  T)

    from usolves_odeD(4)[OF x _ _ _ (z solves_ode f) _ _, of s] prems
    have "z s = x s" if "s  T" using that tx  T z tx = x tx
      by (auto simp: is_interval_Int usolves_odeD(3)[OF x] ‹is_interval TS')

    moreover

    {
      assume "s  T"
      then have "s  S" using prems assms by auto
      {
        assume "tx  S"
        then have "tx  T - S" using tx  T by simp
        moreover have "s  S - T" using s  T s  S by blast
        ultimately have "t  TS'"
          apply (rule three_intervals_lemma)
          subgoal using assms by auto
          subgoal using usolves_odeD(3)[OF x] .
          subgoal using usolves_odeD(3)[OF y[OF conn_t]] .
          subgoal using tx  TS' .
          subgoal using s  TS' .
          subgoal using ‹is_interval TS' .
          done
        with assms have t: "t  closure S  closure T  TS'" by simp

        then have "t  S" "t  T" "t  TS'" using assms by auto
        have "z t = x t"
          apply (rule usolves_odeD(4)[OF x _ _ _ z_f, of t])
          using t  TS' t  T prems assms tx  T usolves_odeD(3)[OF x]
          by (auto intro!: is_interval_Int)
        with assms have "z t = y t" using t by auto

        from usolves_odeD(4)[OF y[OF conn_t] _ _ _ z_g, of s] prems
        have "z s = y s" using s  T assms z t = y t t t  S
          ‹is_interval TS' usolves_odeD(3)[OF y[OF conn_t]]
          by (auto simp: is_interval_Int)
      } moreover {
        assume "tx  S"
        with prems closure_subset tx  T
        have tx: "tx  closure S  closure T  TS'" by force

        then have "tx  S" "tx  T" "tx  TS'" using assms by auto
        have "z tx = x tx"
          apply (rule usolves_odeD(4)[OF x _ _ _ z_f, of tx])
          using tx  TS' tx  T prems assms tx  T usolves_odeD(3)[OF x]
          by (auto intro!: is_interval_Int)
        with assms have "z tx = y tx" using tx by auto

        from usolves_odeD(4)[OF y[where t=tx] _ _ _ z_g, of s] prems
        have "z s = y s" using s  T assms z tx = y tx tx tx  S
          ‹is_interval TS' usolves_odeD(3)[OF y]
          by (auto simp: is_interval_Int)
      } ultimately have "z s = y s" by blast
    }
    ultimately
    show "z s = (if s  T then x s else y s)" by simp
  qed
  done

lemma usolves_ode_union_closed:
  assumes x: "(x usolves_ode f from tx) T X"
  assumes y: "t. t  closure S  closure T  (x usolves_ode f from t) S X"
  assumes conn_T: "closure S  closure T  T"
  assumes conn_S: "closure S  closure T  S"
  assumes conn_t: "t  closure S  closure T"
  shows "(x usolves_ode f from tx) (T  S) X"
  using connection_usolves_ode[OF assms] by simp

lemma usolves_ode_solves_odeI:
  assumes "(x usolves_ode f from tx) T X"
  assumes "(y solves_ode f) T X" "y tx = x tx"
  shows "(y usolves_ode f from tx) T X"
  using assms(1)
  apply (rule usolves_ode_congI)
  subgoal using assms by (metis set_eq_subset usolves_odeD(2) usolves_odeD(3) usolves_odeD(4))
  by auto

lemma usolves_ode_subset_range:
  assumes x: "(x usolves_ode f from t0) T X"
  assumes r: "x ` T  Y" and "Y  X"
  shows "(x usolves_ode f from t0) T Y"
proof (rule usolves_odeI)
  note usolves_odeD[OF x]
  show "(x solves_ode f) T Y" by (rule solves_ode_subset_range; fact)
  show "t0  T" "is_interval T" by fact+
  fix z t
  assume s: "{t0 -- t}  T" and z: "(z solves_ode f) {t0 -- t} Y" and z0: "z t0 = x t0"
  then have "t0  {t0 -- t}" "is_interval {t0 -- t}"
    by auto
  moreover note s
  moreover have "(z solves_ode f) {t0--t} X"
    using solves_odeD[OF z] Y  X
    by (intro solves_ode_subset_range[OF z]) force
  moreover note z0
  moreover have "t  {t0 -- t}" by simp
  ultimately show "z t = x t"
    by (rule usolves_odeD[OF x])
qed


subsection ‹ivp on interval›

context
  fixes t0 t1::real and T
  defines "T  closed_segment t0 t1"
begin

lemma is_solution_ext_cont:
  "continuous_on T x  (ext_cont x (min t0 t1) (max t0 t1) solves_ode f) T X = (x solves_ode f) T X"
  by (rule solves_ode_cong) (auto simp add: T_def min_def max_def closed_segment_eq_real_ivl)

lemma solution_fixed_point:
  fixes x:: "real  'a::banach"
  assumes x: "(x solves_ode f) T X" and t: "t  T"
  shows "x t0 + ivl_integral t0 t (λt. f t (x t)) = x t"
proof -
  from solves_odeD(1)[OF x, unfolded T_def]
  have "(x has_vderiv_on (λt. f t (x t))) (closed_segment t0 t)"
    by (rule has_vderiv_on_subset) (insert t  T, auto simp: closed_segment_eq_real_ivl T_def)
  from fundamental_theorem_of_calculus_ivl_integral[OF this]
  have "((λt. f t (x t)) has_ivl_integral x t - x t0) t0 t" .
  from this[THEN ivl_integral_unique]
  show ?thesis by simp
qed

lemma solution_fixed_point_left:
  fixes x:: "real  'a::banach"
  assumes x: "(x solves_ode f) T X" and t: "t  T"
  shows "x t1 - ivl_integral t t1 (λt. f t (x t)) = x t"
proof -
  from solves_odeD(1)[OF x, unfolded T_def]
  have "(x has_vderiv_on (λt. f t (x t))) (closed_segment t t1)"
    by (rule has_vderiv_on_subset) (insert t  T, auto simp: closed_segment_eq_real_ivl T_def)
  from fundamental_theorem_of_calculus_ivl_integral[OF this]
  have "((λt. f t (x t)) has_ivl_integral x t1 - x t) t t1" .
  from this[THEN ivl_integral_unique]
  show ?thesis by simp
qed

lemma solution_fixed_pointI:
  fixes x:: "real  'a::banach"
  assumes cont_f: "continuous_on (T × X) (λ(t, x). f t x)"
  assumes cont_x: "continuous_on T x"
  assumes defined: "t. t  T  x t  X"
  assumes fp: "t. t  T  x t = x t0 + ivl_integral t0 t (λt. f t (x t))"
  shows "(x solves_ode f) T X"
proof (rule solves_odeI)
  note [continuous_intros] = continuous_on_compose_Pair[OF cont_f]
  have "((λt. x t0 + ivl_integral t0 t (λt. f t (x t))) has_vderiv_on (λt. f t (x t))) T"
    using cont_x defined
    by (auto intro!: derivative_eq_intros ivl_integral_has_vector_derivative
      continuous_intros
      simp: has_vderiv_on_def T_def)
  with fp show "(x has_vderiv_on (λt. f t (x t))) T" by simp
qed (simp add: defined)

end

lemma solves_ode_half_open_segment_continuation:
  fixes f::"real  'a  'a::banach"
  assumes ode: "(x solves_ode f) {t0 --< t1} X"
  assumes continuous: "continuous_on ({t0 -- t1} × X) (λ(t, x). f t x)"
  assumes "compact X"
  assumes "t0  t1"
  obtains l where
    "(x  l) (at t1 within {t0 --< t1})"
    "((λt. if t = t1 then l else x t) solves_ode f) {t0 -- t1} X"
proof -
  note [continuous_intros] = continuous_on_compose_Pair[OF continuous]
  have "compact ((λ(t, x). f t x) ` ({t0 -- t1} × X))"
    by (auto intro!: compact_continuous_image continuous_intros compact_Times ‹compact X
      simp: split_beta)
  then obtain B where "B > 0" and B: "t x. t  {t0 -- t1}  x  X  norm (f t x)  B"
    by (auto dest!: compact_imp_bounded simp: bounded_pos)

  have uc: "uniformly_continuous_on {t0 --< t1} x"
    apply (rule lipschitz_on_uniformly_continuous[where L=B])
    apply (rule bounded_vderiv_on_imp_lipschitz)
    apply (rule solves_odeD[OF ode])
    using solves_odeD(2)[OF ode] 0 < B
    by (auto simp: closed_segment_eq_real_ivl half_open_segment_real subset_iff
      intro!: B split: if_split_asm)

  have "t1  closure ({t0 --< t1})"
    using closure_half_open_segment[of t0 t1] t0  t1
    by simp
  from uniformly_continuous_on_extension_on_closure[OF uc]
  obtain g where uc_g: "uniformly_continuous_on {t0--t1} g"
    and xg: "(t. t  {t0 --< t1}  x t = g t)"
    using closure_half_open_segment[of t0 t1] t0  t1
    by metis

  from uc_g[THEN uniformly_continuous_imp_continuous, unfolded continuous_on_def]
  have "(g  g t) (at t within {t0--t1})" if "t{t0--t1}" for t
    using that by auto
  then have g_tendsto: "(g  g t) (at t within {t0--<t1})" if "t{t0--t1}" for t
    using that by (auto intro: tendsto_within_subset half_open_segment_subset)
  then have x_tendsto: "(x  g t) (at t within {t0--<t1})" if "t{t0--t1}" for t
    using that
    by (subst Lim_cong_within[OF refl refl refl xg]) auto
  then have "(x  g t1) (at t1 within {t0 --< t1})"
    by auto
  moreover
  have nbot: "at s within {t0--<t1}  bot" if "s  {t0--t1}" for s
    using that t0  t1
    by (auto simp: trivial_limit_within islimpt_half_open_segment)
  have g_mem: "s  {t0--t1}  g s  X" for s
    apply (rule Lim_in_closed_set[OF compact_imp_closed[OF ‹compact X] _ _ x_tendsto])
    using solves_odeD(2)[OF ode] t0  t1
    by (auto intro!: simp: eventually_at_filter nbot)
  have "(g solves_ode f) {t0 -- t1} X"
    apply (rule solution_fixed_pointI[OF continuous])
    subgoal by (auto intro!: uc_g uniformly_continuous_imp_continuous)
    subgoal by (rule g_mem)
    subgoal premises prems for s
    proof -
      {
        fix s
        assume s: "s  {t0--<t1}"
        with prems have subs: "{t0--s}  {t0--<t1}"
          by (auto simp: half_open_segment_real closed_segment_eq_real_ivl)
        with ode have sol: "(x solves_ode f) ({t0--s}) X"
          by (rule solves_ode_on_subset) (rule order_refl)
        from subs have inner_eq: "t  {t0 -- s}  x t = g t" for t
          by (intro xg) auto
        from solution_fixed_point[OF sol, of s]
        have "g t0 + ivl_integral t0 s (λt. f t (g t)) - g s = 0"
          using s prems t0  t1
          by (auto simp: inner_eq cong: ivl_integral_cong)
      } note fp = this

      from prems have subs: "{t0--s}  {t0--t1}"
        by (auto simp: closed_segment_eq_real_ivl)
      have int: "(λt. f t (g t)) integrable_on {t0--t1}"
        using prems subs
        by (auto intro!: integrable_continuous_closed_segment continuous_intros g_mem
          uc_g[THEN uniformly_continuous_imp_continuous, THEN continuous_on_subset])
      note ivl_tendsto[tendsto_intros] =
        indefinite_ivl_integral_continuous(1)[OF int, unfolded continuous_on_def, rule_format]

      from subs half_open_segment_subset
      have "((λs. g t0 + ivl_integral t0 s (λt. f t (g t)) - g s) 
        g t0 + ivl_integral t0 s (λt. f t (g t)) - g s) (at s within {t0 --< t1})"
        using subs
        by (auto intro!: tendsto_intros ivl_tendsto[THEN tendsto_within_subset]
          g_tendsto[THEN tendsto_within_subset])
      moreover
      have "((λs. g t0 + ivl_integral t0 s (λt. f t (g t)) - g s)  0) (at s within {t0 --< t1})"
        apply (subst Lim_cong_within[OF refl refl refl, where g="λ_. 0"])
        subgoal by (subst fp) auto
        subgoal by simp
        done
      ultimately have "g t0 + ivl_integral t0 s (λt. f t (g t)) - g s = 0"
        using nbot prems tendsto_unique by blast
      then show "g s = g t0 + ivl_integral t0 s (λt. f t (g t))" by simp
    qed
    done
  then have "((λt. if t = t1 then g t1 else x t) solves_ode f) {t0--t1} X"
    apply (rule solves_ode_congI)
    using xg t0  t1
    by (auto simp: half_open_segment_closed_segmentI)
  ultimately show ?thesis ..
qed


subsection ‹Picard-Lindeloef on set of functions into closed set›
text‹\label{sec:plclosed}›

locale continuous_rhs = fixes T X f
  assumes continuous: "continuous_on (T × X) (λ(t, x). f t x)"
begin

lemma continuous_rhs_comp[continuous_intros]:
  assumes [continuous_intros]: "continuous_on S g"
  assumes [continuous_intros]: "continuous_on S h"
  assumes "g ` S  T"
  assumes "h ` S  X"
  shows "continuous_on S (λx. f (g x) (h x))"
  using continuous_on_compose_Pair[OF continuous assms(1,2)] assms(3,4)
  by auto

end

locale global_lipschitz =
  fixes T X f and L::real
  assumes lipschitz: "t. t  T  L-lipschitz_on X (λx. f t x)"

locale closed_domain =
  fixes X assumes closed: "closed X"

locale interval = fixes T::"real set"
  assumes interval: "is_interval T"
begin

lemma closed_segment_subset_domain: "t0  T  t  T  closed_segment t0 t  T"
  by (simp add: closed_segment_subset_interval interval)

lemma closed_segment_subset_domainI: "t0  T  t  T  s  closed_segment t0 t  s  T"
  using closed_segment_subset_domain by force

lemma convex[intro, simp]: "convex T"
  and connected[intro, simp]: "connected T"
  by (simp_all add: interval is_interval_connected is_interval_convex )

end

locale nonempty_set = fixes T assumes nonempty_set: "T  {}"

locale compact_interval = interval + nonempty_set T +
  assumes compact_time: "compact T"
begin

definition "tmin = Inf T"
definition "tmax = Sup T"

lemma
  shows tmin: "t  T  tmin  t" "tmin  T"
    and tmax: "t  T  t  tmax" "tmax  T"
  using nonempty_set
  by (auto intro!: cInf_lower cSup_upper bounded_imp_bdd_below bounded_imp_bdd_above
    compact_imp_bounded compact_time closed_contains_Inf closed_contains_Sup compact_imp_closed
    simp: tmin_def tmax_def)

lemma tmin_le_tmax[intro, simp]: "tmin  tmax"
  using nonempty_set tmin tmax by auto

lemma T_def: "T = {tmin .. tmax}"
  using closed_segment_subset_interval[OF interval tmin(2) tmax(2)]
  by (auto simp: closed_segment_eq_real_ivl subset_iff intro!: tmin tmax)

lemma mem_T_I[intro, simp]: "tmin  t  t  tmax  t  T"
  using interval mem_is_interval_1_I tmax(2) tmin(2) by blast

end

locale self_mapping = interval T for T +
  fixes t0::real and x0 f X
  assumes iv_defined: "t0  T" "x0  X"
  assumes self_mapping:
    "x t. t  T  x t0 = x0  x  closed_segment t0 t  X 
      continuous_on (closed_segment t0 t) x  x t0 + ivl_integral t0 t (λt. f t (x t))  X"
begin

sublocale nonempty_set T using iv_defined by unfold_locales auto

lemma closed_segment_iv_subset_domain: "t  T  closed_segment t0 t  T"
  by (simp add: closed_segment_subset_domain iv_defined)

end

locale unique_on_closed =
  compact_interval T +
  self_mapping T t0 x0 f X +
  continuous_rhs T X f +
  closed_domain X +
  global_lipschitz T X f L for t0::real and T and x0::"'a::banach" and f X L
begin

lemma T_split: "T = {tmin .. t0}  {t0 .. tmax}"
  by (metis T_def atLeastAtMost_iff iv_defined(1) ivl_disj_un_two_touch(4))

lemma L_nonneg: "0  L"
  by (auto intro!: lipschitz_on_nonneg[OF lipschitz] iv_defined)

text ‹Picard Iteration›

definition P_inner where "P_inner x t = x0 + ivl_integral t0 t (λt. f  t (x t))"

definition P::"(real C 'a)  (real C 'a)"
  where "P x = (SOME g::realC 'a.
    (t  T. g t = P_inner x t) 
    (ttmin. g t = P_inner x tmin) 
    (ttmax. g t = P_inner x tmax))"

lemma cont_P_inner_ivl:
  "x  T C X  continuous_on {tmin..tmax} (P_inner (apply_bcontfun x))"
  apply (auto simp: real_Icc_closed_segment P_inner_def Pi_iff mem_PiC_iff
      intro!: continuous_intros indefinite_ivl_integral_continuous_subset
      integrable_continuous_closed_segment tmin(1) tmax(1))
  using closed_segment_subset_domainI tmax(2) tmin(2) apply blast
  using closed_segment_subset_domainI tmax(2) tmin(2) apply blast
  using T_def closed_segment_eq_real_ivl iv_defined(1) by auto

lemma P_inner_t0[simp]: "P_inner g t0 = x0"
  by (simp add: P_inner_def)

lemma t0_cs_tmin_tmax: "t0  {tmin--tmax}" and cs_tmin_tmax_subset: "{tmin--tmax}  T"
  using iv_defined T_def closed_segment_eq_real_ivl
  by auto

lemma
  P_eqs:
  assumes "x  T C X"
  shows P_eq_P_inner: "t  T  P x t = P_inner x t"
    and P_le_tmin: "t  tmin  P x t = P_inner x tmin"
    and P_ge_tmax: "t  tmax  P x t = P_inner x tmax"
  unfolding atomize_conj atomize_imp
proof goal_cases
  case 1
  obtain g where
    "t  {tmin .. tmax}  apply_bcontfun g t = P_inner (apply_bcontfun x) t"
    "apply_bcontfun g t = P_inner (apply_bcontfun x) (clamp tmin tmax t)"
    for t
    by (metis continuous_on_cbox_bcontfunE cont_P_inner_ivl[OF assms(1)] cbox_interval)
  with T_def have "g::realC 'a.
    (t  T. g t = P_inner x t) 
    (ttmin. g t = P_inner x tmin) 
    (ttmax. g t = P_inner x tmax)"
    by (auto intro!: exI[where x=g])
  then have "(t  T. P x t = P_inner x t) 
    (ttmin. P x t = P_inner x tmin) 
    (ttmax. P x t = P_inner x tmax)"
    unfolding P_def
    by (rule someI_ex)
  then show ?case using T_def by auto
qed

lemma P_if_eq:
  "x  T C X 
    P x t = (if tmin  t  t  tmax then P_inner x t else if t  tmax then P_inner x tmax else P_inner x tmin)"
  by (auto simp: P_eqs)

lemma dist_P_le:
  assumes y: "y  T C X" and z: "z  T C X"
  assumes le: "t. tmin  t  t  tmax  dist (P_inner y t) (P_inner z t)  R"
  assumes "0  R"
  shows "dist (P y t) (P z t)  R"
  by (cases "t  tmin"; cases "t  tmax") (auto simp: P_eqs y z not_le intro!: le)

lemma P_def':
  assumes "t  T"
  assumes "fixed_point  T C X"
  shows "(P fixed_point) t = x0 + ivl_integral t0 t (λx. f x (fixed_point x))"
  by (simp add: P_eq_P_inner assms P_inner_def)

definition "iter_space = PiC T ((λ_. X)(t0:={x0}))"

lemma iter_spaceI:
  assumes "g  T C X" "g t0 = x0"
  shows "g  iter_space"
  using assms
  by (simp add: iter_space_def mem_PiC_iff Pi_iff)

lemma iter_spaceD:
  assumes "g  iter_space"
  shows "g  T C X" "apply_bcontfun g t0 = x0"
  using assms iv_defined
  by (auto simp add: iter_space_def mem_PiC_iff split: if_splits)

lemma const_in_iter_space: "const_bcontfun x0  iter_space"
  by (auto simp: iter_space_def iv_defined mem_PiC_iff)

lemma closed_iter_space: "closed iter_space"
  by (auto simp: iter_space_def intro!: closed_PiC closed)

lemma iter_space_notempty: "iter_space  {}"
  using const_in_iter_space by blast

lemma clamp_in_eq[simp]: fixes a x b::real shows "a  x  x  b  clamp a b x = x"
  by (auto simp: clamp_def)

lemma P_self_mapping:
  assumes in_space: "g  iter_space"
  shows "P g  iter_space"
proof (rule iter_spaceI)
  show x0: "P g t0 = x0"
    by (auto simp: P_def' iv_defined iter_spaceD[OF in_space])
  from iter_spaceD(1)[OF in_space] show "P g  T C X"
    unfolding mem_PiC_iff Pi_iff
    apply (auto simp: mem_PiC_iff Pi_iff P_def')
    apply (auto simp: iter_spaceD(2)[OF in_space, symmetric] intro!: self_mapping)
    using closed_segment_subset_domainI iv_defined(1) by blast
qed

lemma continuous_on_T: "continuous_on {tmin .. tmax} g  continuous_on T g"
  using T_def by auto

lemma T_closed_segment_subsetI[intro, simp]: "t  {tmin--tmax}  t  T"
  and T_subsetI[intro, simp]: "tmin  t  t  tmax  t  T"
  by (subst T_def, simp add: closed_segment_eq_real_ivl)+

lemma t0_mem_closed_segment[intro, simp]: "t0  {tmin--tmax}"
  using T_def iv_defined
  by (simp add: closed_segment_eq_real_ivl)

lemma tmin_le_t0[intro, simp]: "tmin  t0"
  and tmax_ge_t0[intro, simp]: "tmax  t0"
  using t0_mem_closed_segment
  unfolding closed_segment_eq_real_ivl
  by simp_all

lemma apply_bcontfun_solution_fixed_point:
  assumes ode: "(apply_bcontfun x solves_ode f) T X"
  assumes iv: "x t0 = x0"
  assumes t: "t  T"
  shows "P x t = x t"
proof -
  have "t  {t0 -- t}" by simp
  have ode': "(apply_bcontfun x solves_ode f) {t0--t} X" "t  {t0 -- t}"
    using ode T_def closed_segment_eq_real_ivl t apply auto
    using closed_segment_iv_subset_domain solves_ode_on_subset apply fastforce
    using closed_segment_iv_subset_domain solves_ode_on_subset apply fastforce
    done
  from solves_odeD[OF ode]
  have x: "x  T C X" by (auto simp: mem_PiC_iff)
  from solution_fixed_point[OF ode'] iv
  show ?thesis
    unfolding P_def'[OF t x]
    by simp
qed

lemma
  solution_in_iter_space:
  assumes ode: "(apply_bcontfun z solves_ode f) T X"
  assumes iv: "z t0 = x0"
  shows "z  iter_space" (is "?z  _")
proof -
  from T_def ode have ode: "(z solves_ode f) {tmin -- tmax} X"
    by (simp add: closed_segment_eq_real_ivl)
  have "(?z solves_ode f) T X"
    using is_solution_ext_cont[OF solves_ode_continuous_on[OF ode], of f X] ode T_def
    by (auto simp: min_def max_def closed_segment_eq_real_ivl)
  then have "z  T C X"
    by (auto simp add: solves_ode_def mem_PiC_iff)
  thus "?z  iter_space"
    by (auto simp: iv intro!: iter_spaceI)
qed

end

locale unique_on_bounded_closed = unique_on_closed +
  assumes lipschitz_bound: "s t. s  T  t  T  abs (s - t) * L < 1"
begin

lemma lipschitz_bound_maxmin: "(tmax - tmin) * L < 1"
  using lipschitz_bound[of tmax tmin]
  by auto

lemma lipschitz_P:
  shows "((tmax - tmin) * L)-lipschitz_on iter_space P"
proof (rule lipschitz_onI)
  have "t0  T" by (simp add: iv_defined)
  then show "0  (tmax - tmin) * L"
    using T_def
    by (auto intro!: mult_nonneg_nonneg lipschitz lipschitz_on_nonneg[OF lipschitz]
      iv_defined)
  fix y z
  assume "y  iter_space" and "z  iter_space"
  hence y_defined: "y  (T C X)" and "y t0 = x0"
    and z_defined: "z  (T C X)" and "y t0 = x0"
    by (auto dest: iter_spaceD)
  have defined: "s  T" "y s  X" "z s  X" if "s  closed_segment tmin tmax" for s
    using y_defined z_defined that T_def
    by (auto simp: mem_PiC_iff)
  {
    note [intro, simp] = integrable_continuous_closed_segment
    fix t
    assume t_bounds: "tmin  t" "t  tmax"
    then have cs_subs: "closed_segment t0 t  closed_segment tmin tmax"
      by (auto simp: closed_segment_eq_real_ivl)
    then have cs_subs_ext: "ta. ta  {t0--t}  ta  {tmin--tmax}" by auto

    have "norm (P_inner y t - P_inner z t) =
      norm (ivl_integral t0 t (λt. f t (y t) - f t (z t)))"
      by (subst ivl_integral_diff)
        (auto intro!: integrable_continuous_closed_segment continuous_intros defined cs_subs_ext simp: P_inner_def)
    also have "...  abs (ivl_integral t0 t (λt. norm (f t (y t) - f t (z t))))"
      by (rule ivl_integral_norm_bound_ivl_integral)
        (auto intro!: ivl_integral_norm_bound_ivl_integral continuous_intros integrable_continuous_closed_segment
          simp: defined cs_subs_ext)
    also have "...  abs (ivl_integral t0 t (λt. L * norm (y t - z t)))"
      using lipschitz t_bounds T_def y_defined z_defined cs_subs
      by (intro norm_ivl_integral_le) (auto intro!: continuous_intros integrable_continuous_closed_segment
        simp add: dist_norm lipschitz_on_def mem_PiC_iff Pi_iff)
    also have "...  abs (ivl_integral t0 t (λt. L * norm (y - z)))"
      using norm_bounded[of "y - z"]
        L_nonneg
      by (intro norm_ivl_integral_le) (auto intro!: continuous_intros mult_left_mono)
    also have "... = L * abs (t - t0) * norm (y - z)"
      using t_bounds L_nonneg by (simp add: abs_mult)
    also have "...  L * (tmax - tmin) * norm (y - z)"
      using t_bounds zero_le_dist L_nonneg cs_subs tmin_le_t0 tmax_ge_t0
      by (auto intro!: mult_right_mono mult_left_mono simp: closed_segment_eq_real_ivl abs_real_def
        simp del: tmin_le_t0 tmax_ge_t0 split: if_split_asm)
    finally
    have "dist (P_inner y t) (P_inner z t)  (tmax - tmin) * L * dist y z"
      by (simp add: dist_norm ac_simps)
  } note * = this
  show "dist (P y) (P z)  (tmax - tmin) * L * dist y z"
    by (auto intro!: dist_bound dist_P_le * y_defined z_defined mult_nonneg_nonneg L_nonneg)
qed


lemma fixed_point_unique: "∃!xiter_space. P x = x"
  using lipschitz lipschitz_bound_maxmin lipschitz_P T_def
      complete_UNIV iv_defined
  by (intro banach_fix)
    (auto
      intro: P_self_mapping split_mult_pos_le
      intro!: closed_iter_space iter_space_notempty mult_nonneg_nonneg
      simp: lipschitz_on_def complete_eq_closed)

definition fixed_point where
  "fixed_point = (THE x. x  iter_space  P x = x)"

lemma fixed_point':
  "fixed_point  iter_space  P fixed_point = fixed_point"
  unfolding fixed_point_def using fixed_point_unique
  by (rule theI')

lemma fixed_point:
  "fixed_point  iter_space" "P fixed_point = fixed_point"
  using fixed_point' by simp_all

lemma fixed_point_equality': "x  iter_space  P x = x  fixed_point = x"
  unfolding fixed_point_def using fixed_point_unique
  by (rule the1_equality)

lemma fixed_point_equality: "x  iter_space  P x = x  fixed_point = x"
  using fixed_point_equality'[of x] by auto

lemma fixed_point_iv: "fixed_point t0 = x0"
  and fixed_point_domain: "x  T  fixed_point x  X"
  using fixed_point
  by (force dest: iter_spaceD simp: mem_PiC_iff)+

lemma fixed_point_has_vderiv_on: "(fixed_point has_vderiv_on (λt. f t (fixed_point t))) T"
proof -
  have "continuous_on T (λx. f x (fixed_point x))"
    using fixed_point_domain
    by (auto intro!: continuous_intros)
  then have "((λu. x0 + ivl_integral t0 u (λx. f x (fixed_point x))) has_vderiv_on (λt. f t (fixed_point t))) T"
    by (auto intro!: derivative_intros ivl_integral_has_vderiv_on_compact_interval interval compact_time)
  then show ?thesis
  proof (rule has_vderiv_eq)
    fix t
    assume t: "t  T"
    have "fixed_point t = P fixed_point t"
      using fixed_point by simp
    also have " = x0 + ivl_integral t0 t (λx. f x (fixed_point x))"
      using t fixed_point_domain
      by (auto simp: P_def' mem_PiC_iff)
    finally show "x0 + ivl_integral t0 t (λx. f x (fixed_point x)) = fixed_point t" by simp
  qed (insert T_def, auto simp: closed_segment_eq_real_ivl)
qed

lemma fixed_point_solution:
  shows "(fixed_point solves_ode f) T X"
  using fixed_point_has_vderiv_on fixed_point_domain
  by (rule solves_odeI)


subsubsection ‹Unique solution›
text‹\label{sec:ivp-ubs}›

lemma solves_ode_equals_fixed_point:
  assumes ode: "(x solves_ode f) T X"
  assumes iv: "x t0 = x0"
  assumes t: "t  T"
  shows "x t = fixed_point t"
proof -
  from solves_ode_continuous_on[OF ode] T_def
  have "continuous_on (cbox tmin tmax) x" by simp
  from continuous_on_cbox_bcontfunE[OF this]
  obtain g where g:
    "t  {tmin .. tmax}  apply_bcontfun g t = x t"
    "apply_bcontfun g t = x (clamp tmin tmax t)"
    for t
    by (metis interval_cbox)
  with ode T_def have ode_g: "(g solves_ode f) T X"
    by (metis (no_types, lifting) solves_ode_cong)
  have "x t = g t"
    using t T_def
    by (intro g[symmetric]) auto
  also
  have "g t0 = x0" "g  T C X"
    using iv g solves_odeD(2)[OF ode_g]
    unfolding mem_PiC_iff atLeastAtMost_iff
    by blast+
  then have "g  iter_space"
    by (intro iter_spaceI)
  then have "g = fixed_point"
    apply (rule fixed_point_equality[symmetric])
    apply (rule bcontfun_eqI)
    subgoal for t
      using apply_bcontfun_solution_fixed_point[OF ode_g g t0 = x0, of tmin]
        apply_bcontfun_solution_fixed_point[OF ode_g g t0 = x0, of tmax]
        apply_bcontfun_solution_fixed_point[OF ode_g g t0 = x0, of t]
      using T_def
      by (fastforce simp: P_eqs not_le g  T C X g)
    done
  finally show ?thesis .
qed

lemma solves_ode_on_closed_segment_equals_fixed_point:
  assumes ode: "(x solves_ode f) {t0 -- t1'} X"
  assumes iv: "x t0 = x0"
  assumes subset: "{t0--t1'}  T"
  assumes t_mem: "t  {t0--t1'}"
  shows "x t = fixed_point t"
proof -
  have subsetI: "t  {t0--t1'}  t  T" for t
    using subset by auto
  interpret s: unique_on_bounded_closed t0 "{t0--t1'}" x0 f X L
    apply - apply unfold_locales
    subgoal by (simp add: closed_segment_eq_real_ivl)
    subgoal by simp
    subgoal by simp
    subgoal by simp
    subgoal using iv_defined by simp
    subgoal by (intro self_mapping subsetI)
    subgoal by (rule continuous_on_subset[OF continuous]) (auto simp: subsetI )
    subgoal by (rule lipschitz) (auto simp: subsetI)
    subgoal by (auto intro!: subsetI lipschitz_bound)
    done
  have "x t = s.fixed_point t"
    by (rule s.solves_ode_equals_fixed_point; fact)
  moreover
  have "fixed_point t = s.fixed_point t"
    by (intro s.solves_ode_equals_fixed_point solves_ode_on_subset[OF fixed_point_solution] assms
      fixed_point_iv order_refl subset t_mem)
  ultimately show ?thesis by simp
qed

lemma unique_solution:
  assumes ivp1: "(x solves_ode f) T X" "x t0 = x0"
  assumes ivp2: "(y solves_ode f) T X" "y t0 = x0"
  assumes "t  T"
  shows "x t = y t"
  using solves_ode_equals_fixed_point[OF ivp1 t  T]
    solves_ode_equals_fixed_point[OF ivp2 t  T]
  by simp

lemma fixed_point_usolves_ode: "(fixed_point usolves_ode f from t0) T X"
  apply (rule usolves_odeI[OF fixed_point_solution])
  subgoal by (simp add: iv_defined(1))
  subgoal by (rule interval)
  subgoal
    using fixed_point_iv solves_ode_on_closed_segment_equals_fixed_point
    by auto
  done

end

lemma closed_segment_Un:
  fixes a b c::real
  assumes "b  closed_segment a c"
  shows "closed_segment a b  closed_segment b c = closed_segment a c"
  using assms
  by (auto simp: closed_segment_eq_real_ivl)

lemma closed_segment_closed_segment_subset:
  fixes s::real and i::nat
  assumes "s  closed_segment a b"
  assumes "a  closed_segment c d" "b  closed_segment c d"
  shows "s  closed_segment c d"
  using assms
  by (auto simp: closed_segment_eq_real_ivl split: if_split_asm)


context unique_on_closed begin

context― ‹solution until t1›
  fixes t1::real
  assumes mem_t1: "t1  T"
begin

lemma subdivide_count_ex: "n. L * abs (t1 - t0) / (Suc n) < 1"
  by auto (meson add_strict_increasing less_numeral_extra(1) real_arch_simple)

definition "subdivide_count = (SOME n. L * abs (t1 - t0) / Suc n < 1)"

lemma subdivide_count: "L * abs (t1 - t0) / Suc subdivide_count < 1"
  unfolding subdivide_count_def
  using subdivide_count_ex
  by (rule someI_ex)

lemma subdivide_lipschitz:
  assumes "¦s - t¦  abs (t1 - t0) / Suc subdivide_count"
  shows "¦s - t¦ * L < 1"
proof -
  from assms L_nonneg
  have "¦s - t¦ * L  abs (t1 - t0) / Suc subdivide_count * L"
    by (rule mult_right_mono)
  also have " < 1"
    using subdivide_count
    by (simp add: ac_simps)
  finally show ?thesis .
qed

lemma subdivide_lipschitz_lemma:
  assumes st: "s  {a -- b}" "t  {a -- b}"
  assumes "abs (b - a)  abs (t1 - t0) / Suc subdivide_count"
  shows "¦s - t¦ * L < 1"
  apply (rule subdivide_lipschitz)
  apply (rule order_trans[where y="abs (b - a)"])
  using assms
  by (auto simp: closed_segment_eq_real_ivl split: if_splits)

definition "step = (t1 - t0) / Suc subdivide_count"

lemma last_step: "t0 + real (Suc subdivide_count) * step = t1"
  by (auto simp: step_def)

lemma step_in_segment:
  assumes "0  i" "i  real (Suc subdivide_count)"
  shows "t0 + i * step  closed_segment t0 t1"
  unfolding closed_segment_eq_real_ivl step_def
proof (clarsimp, safe)
  assume "t0  t1"
  then have "(t1 - t0) * i  (t1 - t0) * (1 + subdivide_count)"
    using assms
    by (auto intro!: mult_left_mono)
  then show "t0 + i * (t1 - t0) / (1 + real subdivide_count)  t1"
    by (simp add: field_simps)
next
  assume "¬t0  t1"
  then have "(1 + subdivide_count) * (t0 - t1)  i * (t0 - t1)"
    using assms
    by (auto intro!: mult_right_mono)
  then show "t1  t0 + i * (t1 - t0) / (1 + real subdivide_count)"
    by (simp add: field_simps)
  show "i * (t1 - t0) / (1 + real subdivide_count)  0"
    using ¬t0  t1
    by (auto simp: divide_simps mult_le_0_iff assms)
qed (auto intro!: divide_nonneg_nonneg mult_nonneg_nonneg assms)

lemma subset_T1:
  fixes s::real and i::nat
  assumes "s  closed_segment t0 (t0 + i * step)"
  assumes "i  Suc subdivide_count"
  shows "s  {t0 -- t1}"
  using closed_segment_closed_segment_subset assms of_nat_le_iff of_nat_0_le_iff step_in_segment
  by blast

lemma subset_T: "{t0 -- t1}  T" and subset_TI: "s  {t0 -- t1}  s  T"
  using closed_segment_iv_subset_domain mem_t1 by blast+

primrec psolution::"nat  real  'a" where
  "psolution 0 t = x0"
| "psolution (Suc i) t = unique_on_bounded_closed.fixed_point
    (t0 + real i * step) {t0 + real i * step -- t0 + real (Suc i) * step}
    (psolution i (t0 + real i * step)) f X t"

definition "psolutions t = psolution (LEAST i. t  closed_segment (t0 + real (i - 1) * step) (t0 + real i * step)) t"

lemma psolutions_usolves_until_step:
  assumes i_le: "i  Suc subdivide_count"
  shows "(psolutions usolves_ode f from t0) (closed_segment t0 (t0 + real i * step)) X"
proof cases
  assume "t0 = t1"
  then have "step = 0"
    unfolding step_def by simp
  then show ?thesis by (simp add: psolutions_def iv_defined usolves_ode_singleton)
next
  assume "t0  t1"
  then have "step  0"
    by (simp add: step_def)
  define S where "S  λi. closed_segment (t0 + real (i - 1) * step) (t0 + real i * step)"
  have solution_eq: "psolutions  λt. psolution (LEAST i. t  S i) t"
    by (simp add: psolutions_def[abs_def] S_def)
  show ?thesis
    unfolding solution_eq
    using i_le
  proof (induction i)
    case 0 then show ?case by (simp add: iv_defined usolves_ode_singleton S_def)
  next
    case (Suc i)
    let ?sol = "λt. psolution (LEAST i. t  S i) t"
    let ?pi = "t0 + real (i - Suc 0) * step" and ?i = "t0 + real i * step" and ?si = "t0 + (1 + real i) * step"
    from Suc have ui: "(?sol usolves_ode f from t0) (closed_segment t0 (t0 + real i * step)) X"
      by simp

    from usolves_odeD(1)[OF Suc.IH] Suc
    have IH_sol: "(?sol solves_ode f) (closed_segment t0 ?i) X"
      by simp

    have Least_eq_t0[simp]: "(LEAST n. t0  S n) = 0"
      by (rule Least_equality) (auto simp add: S_def)
    have Least_eq[simp]: "(LEAST n. t0 + real i * step  S n) = i" for i
      apply (rule Least_equality)
      subgoal by (simp add: S_def)
      subgoal
        using ‹step  0
        by (cases "step  0")
          (auto simp add: S_def closed_segment_eq_real_ivl zero_le_mult_iff split: if_split_asm)
      done

    have "y = t0 + real i * s"
      if "t0 + (1 + real i) * s  t" "t  y" "y  t0 + real i * s" "t0  y"
      for y i s t
    proof -
      from that have "(1 + real i) * s  real i * s" "0  real i * s"
        by arith+
      have "s + (t0 + s * real i)  t  t  y  y  t0 + s * real i  t0  y  y = t0 + s * real i"
        by (metis add_decreasing2 eq_iff le_add_same_cancel2 linear mult_le_0_iff of_nat_0_le_iff order.trans)
      then show ?thesis using that
        by (simp add: algebra_simps)
    qed
    then have segment_inter:
      "xa = t0 + real i * step"
      if
      "t  {t0 + real (Suc i - 1) * step--t0 + real (Suc i) * step}"
      "xa  closed_segment (t0 + real i * step) t" "xa  closed_segment t0 (t0 + real i * step)"
      for xa t
      apply (cases "step > 0"; cases "step = 0")
      using that
      by (auto simp: S_def closed_segment_eq_real_ivl split: if_split_asm)

    have right_cond: "t0  t" "t  t1" if "t0 + real i * step  t" "t  t0 + (step + real i * step)" for t
    proof -
      from that have "0  step" by simp
      with last_step have "t0  t1"
        by (metis le_add_same_cancel1 of_nat_0_le_iff zero_le_mult_iff)
      from that have "t0  t - real i * step" by simp
      also have "  t" using that by (auto intro!: mult_nonneg_nonneg)
      finally show "t0  t" .
      have "t  t0 + (real (Suc i) * step)" using that by (simp add: algebra_simps)
      also have "  t1"
      proof -
        have "real (Suc i) * (t1 - t0)  real (Suc subdivide_count) * (t1 - t0)"
          using Suc.prems t0  t1
          by (auto intro!: mult_mono)
        then show ?thesis by (simp add: divide_simps algebra_simps step_def)
      qed
      finally show "t  t1" .
    qed
    have left_cond: "t1  t" "t  t0" if "t0 + (step + real i * step)  t" "t  t0 + real i * step" for t
    proof -
      from that have "step  0" by simp
      with last_step have "t1  t0"
        by (metis add_le_same_cancel1 mult_nonneg_nonpos of_nat_0_le_iff)
      from that have "t0  t - real i * step" by simp
      also have "t - real i * step  t" using that by (auto intro!: mult_nonneg_nonpos)
      finally (xtrans) show "t  t0" .
      have "t  t0 + (real (Suc i) * step)" using that by (simp add: algebra_simps)
      also have " t0 + (real (Suc i) * step)  t1"
      proof -
        have "real (Suc i) * (t0 - t1)  real (Suc subdivide_count) * (t0 - t1)"
          using Suc.prems t0  t1
          by (auto intro!: mult_mono)
        then show ?thesis by (simp add: divide_simps algebra_simps step_def)
      qed
      finally (xtrans) show "t1  t" .
    qed

    interpret l: self_mapping "S (Suc i)" ?i "?sol ?i" f X
    proof unfold_locales
      show "?sol ?i  X"
        using solves_odeD(2)[OF usolves_odeD(1)[OF ui], of "?i"]
        by (simp add: S_def)
      fix x t assume t[unfolded S_def]: "t  S (Suc i)"
        and x: "x ?i = ?sol ?i" "x  closed_segment ?i t  X"
        and cont: "continuous_on (closed_segment ?i t) x"

      let ?if = "λt. if t  closed_segment t0 ?i then ?sol t else x t"
      let ?f = "λt. f t (?if t)"
      have sol_mem: "?sol s  X" if "s  closed_segment t0 ?i" for s
        by (auto simp: subset_T1 intro!: solves_odeD[OF IH_sol] that)

      from x(1) have "x ?i + ivl_integral ?i t (λt. f t (x t)) = ?sol ?i + ivl_integral ?i t (λt. f t (x t))"
        by simp
      also have "?sol ?i = ?sol t0 + ivl_integral t0 ?i (λt. f t (?sol t))"
        apply (subst solution_fixed_point)
        apply (rule usolves_odeD[OF ui])
        by simp_all
      also have "ivl_integral t0 ?i (λt. f t (?sol t)) = ivl_integral t0 ?i ?f"
        by (simp cong: ivl_integral_cong)
      also
      have psolution_eq: "x (t0 + real i * step) = psolution i (t0 + real i * step) 
        ta  {t0 + real i * step--t} 
        ta  {t0--t0 + real i * step}  psolution (LEAST i. ta  S i) ta = x ta" for ta
        by (subst segment_inter[OF t], assumption, assumption)+ simp
      have "ivl_integral ?i t (λt. f t (x t)) = ivl_integral ?i t ?f"
        by (rule ivl_integral_cong) (simp_all add: x psolution_eq)
      also
      from t right_cond(1) have cs: "closed_segment t0 t = closed_segment t0 ?i  closed_segment ?i t"
        by (intro closed_segment_Un[symmetric])
          (auto simp: closed_segment_eq_real_ivl algebra_simps mult_le_0_iff split: if_split_asm
            intro!: segment_inter segment_inter[symmetric])
      have cont_if: "continuous_on (closed_segment t0 t) ?if"
        unfolding cs
        using x Suc.prems cont t psolution_eq
        by (auto simp: subset_T1 T_def intro!: continuous_on_cases solves_ode_continuous_on[OF IH_sol])
      have t_mem: "t  closed_segment t0 t1"
        using x Suc.prems t
        apply -
        apply (rule closed_segment_closed_segment_subset, assumption)
        apply (rule step_in_segment, force, force)
        apply (rule step_in_segment, force, force)
        done
      have segment_subset: "ta  {t0 + real i * step--t}  ta  {t0--t1}" for ta
        using x Suc.prems
        apply -
        apply (rule closed_segment_closed_segment_subset, assumption)
        subgoal by (rule step_in_segment; force)
        subgoal by (rule t_mem)
        done
      have cont_f: "continuous_on (closed_segment t0 t) ?f"
        apply (rule continuous_intros)
        apply (rule continuous_intros)
        apply (rule cont_if)
        unfolding cs
        using x Suc.prems
         apply (auto simp: subset_T1 segment_subset intro!: sol_mem subset_TI)
        done
      have "?sol t0 + ivl_integral t0 ?i ?f + ivl_integral ?i t ?f = ?if t0 + ivl_integral t0 t ?f"
        by (auto simp: cs intro!: ivl_integral_combine integrable_continuous_closed_segment
          continuous_on_subset[OF cont_f])
      also have "  X"
        apply (rule self_mapping)
        apply (rule subset_TI)
        apply (rule t_mem)
        using x cont_if
        by (auto simp: subset_T1 Pi_iff cs intro!: sol_mem)
      finally
      have "x ?i + ivl_integral ?i t (λt. ?f t)  X" .
      also have "ivl_integral ?i t (λt. ?f t) = ivl_integral ?i t (λt. f t (x t))"
        apply (rule ivl_integral_cong[OF _ refl refl])
        using x
        by (auto simp: segment_inter psolution_eq)
      finally
      show "x ?i + ivl_integral ?i t (λt. f t (x t))  X" .
    qed (auto simp add: S_def closed_segment_eq_real_ivl)
    have "S (Suc i)  T"
      unfolding S_def
      apply (rule subsetI)
      apply (rule subset_TI)
    proof (cases "step = 0")
      case False
      fix x assume x: "x  {t0 + real (Suc i - 1) * step--t0 + real (Suc i) * step}"
      from x have nn: "((x - t0) / step)  0"
        using False right_cond(1)[of x] left_cond(2)[of x]
        by (auto simp: closed_segment_eq_real_ivl divide_simps algebra_simps split: if_splits)
      have "t1 < t0  t1  x" "t1 > t0  x  t1"
        using x False right_cond(1,2)[of x] left_cond(1,2)[of x]
        by (auto simp: closed_segment_eq_real_ivl algebra_simps split: if_splits)
      then have le: "(x - t0) / step  1 + real subdivide_count"
        unfolding step_def
        by (auto simp: divide_simps)
      have "x = t0 + ((x - t0) / step) * step"
        using False
        by auto
      also have "  {t0 -- t1}"
        by (rule step_in_segment) (auto simp: nn le)
      finally show "x  {t0 -- t1}" by simp
    qed simp
    have algebra: "(1 + real i) * (t1 - t0) - real i * (t1 - t0) = t1 - t0"
      by (simp only: algebra_simps)
    interpret l: unique_on_bounded_closed ?i "S (Suc i)" "?sol ?i" f X L
      apply unfold_locales
      subgoal by (auto simp: S_def)
      subgoal using S (Suc i)  T by (auto intro!: continuous_intros simp: split_beta')
      subgoal using S (Suc i)  T by (auto intro!: lipschitz)
      subgoal by (rule subdivide_lipschitz_lemma) (auto simp add: step_def divide_simps algebra S_def)
      done
    note ui
    moreover
    have mem_SI: "t  closed_segment ?i ?si  t  S (if t = ?i then i else Suc i)" for t
      by (auto simp: S_def)
    have min_S: "(if t = t0 + real i * step then i else Suc i)  y"
      if "t  closed_segment (t0 + real i * step) (t0 + (1 + real i) * step)"
        "t  S y"
      for y t
      apply (cases "t = t0 + real i * step")
      subgoal using that ‹step  0
        by (auto simp add: S_def closed_segment_eq_real_ivl algebra_simps zero_le_mult_iff split: if_splits )
      subgoal premises ne
      proof (cases)
        assume "step > 0"
        with that have "t0 + real i * step  t" "t  t0 + (1 + real i) * step"
          "t0 + real (y - Suc 0) * step  t" "t  t0 + real y * step"
          by (auto simp: closed_segment_eq_real_ivl S_def)
        then have "real i * step < real y * step" using ‹step > 0 ne
          by arith
        then show ?thesis using ‹step > 0 that by (auto simp add: closed_segment_eq_real_ivl S_def)
      next
        assume "¬ step > 0" with ‹step  0 have "step < 0" by simp
        with that have "t0 + (1 + real i) * step  t" "t  t0 + real i * step"
          "t0 + real y * step  t" "t  t0 + real (y - Suc 0) * step" using ne
          by (auto simp: closed_segment_eq_real_ivl S_def diff_Suc zero_le_mult_iff split: if_splits nat.splits)
        then have "real y * step < real i * step"
          using ‹step < 0 ne
          by arith
        then show ?thesis using ‹step < 0 by (auto simp add: closed_segment_eq_real_ivl S_def)
      qed
      done
    have "(?sol usolves_ode f from ?i) (closed_segment ?i ?si) X"
      apply (subst usolves_ode_cong)
      apply (subst Least_equality)
      apply (rule mem_SI) apply assumption
      apply (rule min_S) apply assumption apply assumption
      apply (rule refl)
      apply (rule refl)
      apply (rule refl)
      apply (rule refl)
      apply (rule refl)
      apply (subst usolves_ode_cong[where y="psolution (Suc i)"])
      using l.fixed_point_iv[unfolded Least_eq]
      apply (simp add: S_def; fail)
      apply (rule refl)
      apply (rule refl)
      apply (rule refl)
      apply (rule refl)
      using l.fixed_point_usolves_ode
      apply -
      apply (simp)
      apply (simp add: S_def)
      done
    moreover have "t  {t0 + real i * step--t0 + (step + real i * step)} 
         t  {t0--t0 + real i * step}  t = t0 + real i * step" for t
      by (subst segment_inter[rotated], assumption, assumption) (auto simp: algebra_simps)
    ultimately
    have "((λt. if t  closed_segment t0 ?i then ?sol t else ?sol t)
      usolves_ode
      (λt. if t  closed_segment t0 ?i then f t else f t) from t0)
      (closed_segment t0 ?i  closed_segment ?i ?si) X"
      by (intro connection_usolves_ode[where t="?i"]) (auto simp: algebra_simps split: if_split_asm)
    also have "closed_segment t0 ?i  closed_segment ?i ?si = closed_segment t0 ?si"
      apply (rule closed_segment_Un)
      by (cases "step < 0")
        (auto simp: closed_segment_eq_real_ivl zero_le_mult_iff mult_le_0_iff
          intro!: mult_right_mono
          split: if_split_asm)
    finally show ?case by simp
  qed
qed

lemma psolutions_usolves_ode: "(psolutions usolves_ode f from t0) {t0 -- t1} X"
proof -
  let ?T = "closed_segment t0 (t0 + real (Suc subdivide_count) * step)"
  have "(psolutions usolves_ode f from t0) ?T X"
    by (rule psolutions_usolves_until_step) simp
  also have "?T = {t0 -- t1}" unfolding last_step ..
  finally show ?thesis .
qed

end

definition "solution t = (if t  t0 then psolutions tmin t else psolutions tmax t)"

lemma solution_eq_left: "tmin  t  t  t0  solution t = psolutions tmin t"
  by (simp add: solution_def)

lemma solution_eq_right: "t0  t  t  tmax  solution t = psolutions tmax t"
  by (simp add: solution_def psolutions_def)

lemma solution_usolves_ode: "(solution usolves_ode f from t0) T X"
proof -
  from psolutions_usolves_ode[OF tmin(2)] tmin_le_t0
  have u1: "(psolutions tmin usolves_ode f from t0) {tmin .. t0} X"
    by (auto simp: closed_segment_eq_real_ivl split: if_splits)
  from psolutions_usolves_ode[OF tmax(2)] tmin_le_t0
  have u2: "(psolutions tmax usolves_ode f from t0) {t0 .. tmax} X"
    by (auto simp: closed_segment_eq_real_ivl split: if_splits)
  have "(solution usolves_ode f from t0) ({tmin .. t0}  {t0 .. tmax}) (X  X)"
    apply (rule usolves_ode_union_closed[where t=t0])
    subgoal by (subst usolves_ode_cong[where y="psolutions tmin"]) (auto simp: solution_eq_left u1)
    subgoal
      using u2
      by (rule usolves_ode_congI) (auto simp: solution_eq_right)
    subgoal by simp
    subgoal by simp
    subgoal by simp
    done
  also have "{tmin .. t0}  {t0 .. tmax} = T"
    by (simp add: T_split[symmetric])
  finally show ?thesis by simp
qed

lemma solution_solves_ode: "(solution solves_ode f) T X"
  by (rule usolves_odeD[OF solution_usolves_ode])

lemma solution_iv[simp]: "solution t0 = x0"
  by (auto simp: solution_def psolutions_def)

end


subsection ‹Picard-Lindeloef for @{term "X = UNIV"}
text‹\label{sec:pl-us}›

locale unique_on_strip =
  compact_interval T +
  continuous_rhs T UNIV f +
  global_lipschitz T UNIV f L
  for t0 and T and f::"real  'a  'a::banach" and L +
  assumes iv_time: "t0  T"
begin

sublocale unique_on_closed t0 T x0 f UNIV L for x0
  by (-, unfold_locales) (auto simp: iv_time)

end


subsection ‹Picard-Lindeloef on cylindric domain›
text‹\label{sec:pl-rect}›

locale solution_in_cylinder =
  continuous_rhs T "cball x0 b" f +
  compact_interval T
  for t0 T x0 b and f::"real  'a  'a::banach" +
  fixes X B
  defines "X  cball x0 b"
  assumes initial_time_in: "t0  T"
  assumes norm_f: "x t. t  T  x  X  norm (f t x)  B"
  assumes b_pos: "b  0"
  assumes e_bounded: "t. t  T  dist t t0  b / B"
begin

lemmas cylinder = X_def

lemma B_nonneg: "B  0"
proof -
  have "0  norm (f t0 x0)" by simp
  also from b_pos norm_f have "...  B" by (simp add: initial_time_in X_def)
  finally show ?thesis by simp
qed

lemma in_bounds_derivativeI:
  assumes "t  T"
  assumes init: "x t0 = x0"
  assumes cont: "continuous_on (closed_segment t0 t) x"
  assumes solves: "(x has_vderiv_on (λs. f s (y s))) (open_segment t0 t)"
  assumes y_bounded: "ξ. ξ  closed_segment t0 t  x ξ  X  y ξ  X"
  shows "x t  cball x0 (B * abs (t - t0))"
proof cases
  assume "b = 0  B = 0" with assms e_bounded T_def have "t = t0"
    by auto
  thus ?thesis using b_pos init by simp
next
  assume "¬(b = 0  B = 0)"
  hence "b > 0" "B > 0" using B_nonneg b_pos by auto
  show ?thesis
  proof cases
    assume "t0  t"
    then have b_less: "B * abs (t - t0)  b"
      using b_pos e_bounded using b > 0 B > 0 t  T
      by (auto simp: field_simps initial_time_in dist_real_def abs_real_def closed_segment_eq_real_ivl split: if_split_asm)
    define b where  "b  B * abs (t - t0)"
    have "b > 0" using t0  t by (auto intro!: mult_pos_pos simp: algebra_simps b_def B > 0)
    from cont
    have closed: "closed (closed_segment t0 t  ((λs. norm (x s - x t0)) -` {b..}))"
      by (intro continuous_closed_preimage continuous_intros closed_segment)
    have exceeding: "{s  closed_segment t0 t. norm (x s - x t0)  {b..}}  {t}"
    proof (rule ccontr)
      assume "¬{s  closed_segment t0 t. norm (x s - x t0)  {b..}}  {t}"
      hence notempty: "(closed_segment t0 t  ((λs. norm (x s - x t0)) -` {b..}))  {}"
        and not_max: "{s  closed_segment t0 t. norm (x s - x t0)  {b..}}  {t}"
        by auto
      obtain s where s_bound: "s  closed_segment t0 t"
        and exceeds: "norm (x s - x t0)  {b..}"
        and min: "t2closed_segment t0 t.
          norm (x t2 - x t0)  {b..}  dist t0 s  dist t0 t2"
        by (rule distance_attains_inf[OF closed notempty, of t0]) blast
      have "s  t0" using exceeds b > 0 by auto
      have st: "closed_segment t0 t  open_segment t0 s" using s_bound
        by (auto simp: closed_segment_eq_real_ivl open_segment_eq_real_ivl)
      from cont have cont: "continuous_on (closed_segment t0 s) x"
        by (rule continuous_on_subset)
          (insert b_pos closed_segment_subset_domain s_bound, auto simp: closed_segment_eq_real_ivl)
      have bnd_cont: "continuous_on (closed_segment t0 s) ((*) B)"
        and bnd_deriv: "((*) B has_vderiv_on (λ_. B)) (open_segment t0 s)"
        by (auto intro!: continuous_intros derivative_eq_intros
          simp: has_vector_derivative_def has_vderiv_on_def)
      {
        fix ss assume ss: "ss  open_segment t0 s"
        with st have "ss  closed_segment t0 t" by auto
        have less_b: "norm (x ss - x t0) < b"
        proof (rule ccontr)
          assume "¬ norm (x ss - x t0) < b"
          hence "norm (x ss - x t0)  {b..}" by auto
          from min[rule_format, OF ss  closed_segment t0 t this]
          show False using ss s  t0
            by (auto simp: dist_real_def open_segment_eq_real_ivl split_ifs)
        qed
        have "norm (f ss (y ss))  B"
          apply (rule norm_f)
          subgoal using ss st closed_segment_subset_domain[OF initial_time_in t  T] by auto
          subgoal using ss st b_less less_b
            by (intro y_bounded)
              (auto simp: X_def dist_norm b_def init norm_minus_commute mem_cball)
          done
      } note bnd = this
      have subs: "open_segment t0 s  open_segment t0 t" using s_bound s  t0
        by (auto simp: closed_segment_eq_real_ivl open_segment_eq_real_ivl)
      with differentiable_bound_general_open_segment[OF cont bnd_cont has_vderiv_on_subset[OF solves subs]
        bnd_deriv bnd]
      have "norm (x s - x t0)  B * ¦s - t0¦"
        by (auto simp: algebra_simps[symmetric] abs_mult B_nonneg)
      also
      have "s  t"
        using s_bound exceeds min not_max
        by (auto simp: dist_norm closed_segment_eq_real_ivl split_ifs)
      hence "B * ¦s - t0¦ < ¦t - t0¦ * B"
        using s_bound B > 0
        by (intro le_neq_trans)
          (auto simp: algebra_simps closed_segment_eq_real_ivl split_ifs
            intro!: mult_left_mono)
      finally have "norm (x s - x t0) < ¦t - t0¦ * B" .
      moreover
      {
        have "b  ¦t - t0¦ * B" by (simp add: b_def algebra_simps)
        also from exceeds have "norm (x s - x t0)  b" by simp
        finally have "¦t - t0¦ * B  norm (x s - x t0)" .
      }
      ultimately show False by simp
    qed note mvt_result = this
    from cont assms
    have cont_diff: "continuous_on (closed_segment t0 t) (λxa. x xa - x t0)"
      by (auto intro!: continuous_intros)
    have "norm (x t - x t0)  b"
    proof (rule ccontr)
      assume H: "¬ norm (x t - x t0)  b"
      hence "b  closed_segment (norm (x t0 - x t0)) (norm (x t - x t0))"
        using assms T_def 0 < b
        by (auto simp: closed_segment_eq_real_ivl )
      from IVT'_closed_segment_real[OF this continuous_on_norm[OF cont_diff]]
      obtain s where s: "s  closed_segment t0 t" "norm (x s - x t0) = b"
        using b > 0 by auto
      have "s  {s  closed_segment t0 t. norm (x s - x t0)  {b..}}"
        using s t  T by (auto simp: initial_time_in)
      with mvt_result have "s = t" by blast
      hence "s = t" using s t  T by (auto simp: initial_time_in)
      with s H show False by simp
    qed
    hence "x t  cball x0 b" using init
      by (auto simp: dist_commute dist_norm[symmetric] mem_cball)
    thus "x t  cball x0 (B * abs (t - t0))" unfolding cylinder b_def .
  qed (simp add: init[symmetric])
qed

lemma in_bounds_derivative_globalI:
  assumes "t  T"
  assumes init: "x t0 = x0"
  assumes cont: "continuous_on (closed_segment t0 t) x"
  assumes solves: "(x has_vderiv_on (λs. f s (y s))) (open_segment t0 t)"
  assumes y_bounded: "ξ. ξ  closed_segment t0 t  x ξ  X  y ξ  X"
  shows "x t  X"
proof -
  from in_bounds_derivativeI[OF assms]
  have "x t  cball x0 (B * abs (t - t0))" .
  moreover have "B * abs (t - t0)  b" using e_bounded b_pos B_nonneg t  T
    by (cases "B = 0")
      (auto simp: field_simps initial_time_in dist_real_def abs_real_def closed_segment_eq_real_ivl split: if_splits)
  ultimately show ?thesis by (auto simp: cylinder mem_cball)
qed

lemma integral_in_bounds:
  assumes "t  T" "x t0 = x0" "x  {t0 -- t}  X"
  assumes cont[continuous_intros]: "continuous_on ({t0 -- t}) x"
  shows "x t0 + ivl_integral t0 t (λt. f t (x t))  X" (is "_ + ?ix t  X")
proof cases
  assume "t = t0"
  thus ?thesis by (auto simp: cylinder b_pos assms)
next
  assume "t  t0"
  from closed_segment_subset_domain[OF initial_time_in]
  have cont_f:"continuous_on {t0 -- t} (λt. f t (x t))"
    using assms
    by (intro continuous_intros)
      (auto intro: cont continuous_on_subset[OF continuous] simp: cylinder split: if_splits)
  from closed_segment_subset_domain[OF initial_time_in t  T]
  have subsets: "s  {t0--t}  s  T" "s  open_segment t0 t  s  {t0--t}" for s
    by (auto simp: closed_segment_eq_real_ivl open_segment_eq_real_ivl initial_time_in split: if_split_asm)
  show ?thesis
    unfolding x t0 = _
    using assms t  t0
    by (intro in_bounds_derivative_globalI[where y=x and x="λt. x0 + ?ix t"])
      (auto simp: initial_time_in subsets cylinder has_vderiv_on_def
        split: if_split_asm
        intro!: cont_f has_vector_derivative_const integrable_continuous_closed_segment
          has_vector_derivative_within_subset[OF ivl_integral_has_vector_derivative]
          has_vector_derivative_add[THEN has_vector_derivative_eq_rhs]
          continuous_intros indefinite_ivl_integral_continuous)
qed

lemma solves_in_cone:
  assumes "t  T"
  assumes init: "x t0 = x0"
  assumes cont: "continuous_on (closed_segment t0 t) x"
  assumes solves: "(x has_vderiv_on (λs. f s (x s))) (open_segment t0 t)"
  shows "x t  cball x0 (B * abs (t - t0))"
  using assms
  by (rule in_bounds_derivativeI)

lemma is_solution_in_cone:
  assumes "t  T"
  assumes sol: "(x solves_ode f) (closed_segment t0 t) Y" and iv: "x t0 = x0"
  shows "x t  cball x0 (B * abs (t - t0))"
  using solves_odeD[OF sol] t  T
  by (intro solves_in_cone)
    (auto intro!: assms vderiv_on_continuous_on segment_open_subset_closed
      intro: has_vderiv_on_subset simp: initial_time_in)

lemma cone_subset_domain:
  assumes "t  T"
  shows "cball x0 (B * ¦t - t0¦)  X"
  using e_bounded[OF assms] B_nonneg b_pos
  unfolding cylinder
  by (intro subset_cball) (auto simp: dist_real_def divide_simps algebra_simps split: if_splits)

lemma is_solution_in_domain:
  assumes "t  T"
  assumes sol: "(x solves_ode f) (closed_segment t0 t) Y" and iv: "x t0 = x0"
  shows "x t  X"
  using is_solution_in_cone[OF assms] cone_subset_domain[OF t  T]
  by (rule rev_subsetD)

lemma solves_ode_on_subset_domain:
  assumes sol: "(x solves_ode f) S Y" and iv: "x t0 = x0"
    and ivl: "t0  S" "is_interval S" "S  T"
  shows "(x solves_ode f) S X"
proof (rule solves_odeI)
  show "(x has_vderiv_on (λt. f t (x t))) S" using solves_odeD(1)[OF sol] .
  show "x s  X" if s: "s  S" for s
  proof -
    from s assms have "s  T"
      by auto
    moreover
    have "{t0--s}  S"
      by (rule closed_segment_subset) (auto simp: s assms is_interval_convex)
    with sol have "(x solves_ode f) {t0--s} Y"
      using order_refl
      by (rule solves_ode_on_subset)
    ultimately
    show ?thesis using iv
      by (rule is_solution_in_domain)
  qed
qed

lemma usolves_ode_on_subset:
  assumes x: "(x usolves_ode f from t0) T X" and iv: "x t0 = x0"
  assumes "t0  S" "is_interval S" "S  T" "X  Y"
  shows "(x usolves_ode f from t0) S Y"
proof (rule usolves_odeI)
  show "(x solves_ode f) S Y" by (rule solves_ode_on_subset[OF usolves_odeD(1)[OF x]]; fact)
  show "t0  S" "is_interval S" by fact+
  fix z t assume "{t0 -- t}  S" and z: "(z solves_ode f) {t0--t} Y" "z t0 = x t0"
  then have "z t0 = x0" "t0  {t0--t}" "is_interval {t0--t}" "{t0--t}  T"
    using iv S  T by (auto simp: is_interval_convex_1)
  with z(1) have zX: "(z solves_ode f) {t0 -- t} X"
    by (rule solves_ode_on_subset_domain)
  show "z t = x t"
    apply (rule usolves_odeD(4)[OF x _ _ _ zX])
    using {t0 -- t}  S S  T
    by (auto simp: is_interval_convex_1 z t0 = x t0)
qed

lemma usolves_ode_on_superset_domain:
  assumes "(x usolves_ode f from t0) T X" and iv: "x t0 = x0"
  assumes "X  Y"
  shows "(x usolves_ode f from t0) T Y"
  using assms(1,2) usolves_odeD(2,3)[OF assms(1)] order_refl assms(3)
  by (rule usolves_ode_on_subset)

end

locale unique_on_cylinder =
  solution_in_cylinder t0 T x0 b f X B +
  global_lipschitz T X f L
  for t0 T x0 b X f B L
begin

sublocale unique_on_closed t0 T x0 f X L
  apply unfold_locales
  subgoal by (simp add: initial_time_in)
  subgoal by (simp add: X_def b_pos)
  subgoal by (auto intro!: integral_in_bounds simp: initial_time_in)
  subgoal by (auto intro!: continuous_intros simp: split_beta' X_def)
  subgoal by (simp add: X_def)
  done

end

locale derivative_on_prod =
  fixes T X and f::"real  'a::banach  'a" and f':: "real × 'a  (real × 'a)  'a"
  assumes f': "tx. tx  T × X  ((λ(t, x). f t x) has_derivative (f' tx)) (at tx within (T × X))"
begin

lemma f'_comp[derivative_intros]:
  "(g has_derivative g') (at s within S)  (h has_derivative h') (at s within S) 
  s  S  (x. x  S  g x  T)  (x. x  S  h x  X) 
  ((λx. f (g x) (h x)) has_derivative (λy. f' (g s, h s) (g' y, h' y))) (at s within S)"
  apply (rule has_derivative_in_compose2[OF f' _ _ has_derivative_Pair, unfolded split_beta' fst_conv snd_conv, of g h S s g' h'])
  apply auto
  done

lemma derivative_on_prod_subset:
  assumes "X'  X"
  shows "derivative_on_prod T X' f f'"
  using assms
  by (unfold_locales) (auto intro!: derivative_eq_intros)

end

end

Theory Picard_Lindeloef_Qualitative

theory Picard_Lindeloef_Qualitative
imports Initial_Value_Problem
begin

subsection ‹Picard-Lindeloef On Open Domains›
text‹\label{sec:qpl}›

subsubsection ‹Local Solution with local Lipschitz›
text‹\label{sec:qpl-lipschitz}›

lemma cball_eq_closed_segment_real:
  fixes x e::real
  shows "cball x e = (if e  0 then {x - e -- x + e} else {})"
  by (auto simp: closed_segment_eq_real_ivl dist_real_def mem_cball)

lemma cube_in_cball:
  fixes x y :: "'a::euclidean_space"
  assumes "r > 0"
  assumes "i. i Basis  dist (x  i) (y  i)  r / sqrt(DIM('a))"
  shows "y  cball x r"
  unfolding mem_cball euclidean_dist_l2[of x y] L2_set_def
proof -
  have "(iBasis. (dist (x  i) (y  i))2)  ((i::'a)Basis. (r / sqrt(DIM('a)))2)"
  proof (intro sum_mono)
    fix i :: 'a
    assume "i  Basis"
    thus "(dist (x  i) (y  i))2  (r / sqrt(DIM('a)))2"
      using assms
      by (auto intro: sqrt_le_D)
  qed
  moreover
  have "...  r2"
    using assms by (simp add: power_divide)
  ultimately
  show "sqrt (iBasis. (dist (x  i) (y  i))2)  r"
    using assms by (auto intro!: real_le_lsqrt sum_nonneg)
qed

lemma cbox_in_cball':
  fixes x::"'a::euclidean_space"
  assumes "0 < r"
  shows "b > 0. b  r  (B. B = (iBasis. b *R i)  (y  cbox (x - B) (x + B). y  cball x r))"
proof (rule, safe)
  have "r / sqrt (real DIM('a))  r / 1"
    using assms  by (auto simp: divide_simps real_of_nat_ge_one_iff)
  thus "r / sqrt (real DIM('a))  r" by simp
next
  let ?B = "iBasis. (r / sqrt (real DIM('a))) *R i"
  show "B. B = ?B  (y  cbox (x - B) (x + B). y  cball x r)"
  proof (rule, safe)
    fix y::'a
    assume "y  cbox (x - ?B) (x + ?B)"
    hence bounds:
      "i. i  Basis  (x - ?B)  i  y  i"
      "i. i  Basis  y  i  (x + ?B)  i"
      by (auto simp: mem_box)
    show "y  cball x r"
    proof (intro cube_in_cball)
      fix i :: 'a
      assume "i Basis"
      with bounds
      have bounds_comp:
        "x  i - r / sqrt (real DIM('a))  y  i"
        "y  i  x  i + r / sqrt (real DIM('a))"
        by (auto simp: algebra_simps)
      thus "dist (x  i) (y  i)  r / sqrt (real DIM('a))"
        unfolding dist_real_def by simp
    qed (auto simp add: assms)
  qed (rule)
qed (auto simp: assms)

lemma Pair1_in_Basis: "i  Basis  (i, 0)  Basis"
 and Pair2_in_Basis: "i  Basis  (0, i)  Basis"
  by (auto simp: Basis_prod_def)

lemma le_real_sqrt_sumsq' [simp]: "y  sqrt (x * x + y * y)"
  by (simp add: power2_eq_square [symmetric])

lemma cball_Pair_split_subset: "cball (a, b) c  cball a c × cball b c"
  by (auto simp: dist_prod_def mem_cball power2_eq_square
      intro: order_trans[OF le_real_sqrt_sumsq] order_trans[OF le_real_sqrt_sumsq'])

lemma cball_times_subset: "cball a (c/2) × cball b (c/2)  cball (a, b) c"
proof -
  {
    fix a' b'
    have "sqrt ((dist a a')2 + (dist b b')2)  dist a a' + dist b b'"
      by (rule real_le_lsqrt) (auto simp: power2_eq_square algebra_simps)
    also assume "a'  cball a (c / 2)"
    then have "dist a a'  c / 2" by (simp add: mem_cball)
    also assume "b'  cball b (c / 2)"
    then have "dist b b'  c / 2" by (simp add: mem_cball)
    finally have "sqrt ((dist a a')2 + (dist b b')2)  c"
      by simp
  } thus ?thesis by (auto simp: dist_prod_def mem_cball)
qed

lemma eventually_bound_pairE:
  assumes "isCont f (t0, x0)"
  obtains B where
    "B  1"
    "eventually (λe. x  cball t0 e × cball x0 e. norm (f x)  B) (at_right 0)"
proof -
  from assms[simplified isCont_def, THEN tendstoD, OF zero_less_one]
  obtain d::real where d: "d > 0"
    "x. x  (t0, x0)  dist x (t0, x0) < d  dist (f x) (f (t0, x0)) < 1"
    by (auto simp: eventually_at)
  have bound: "norm (f (t, x))  norm (f (t0, x0)) + 1"
    if "t  cball t0 (d/3)" "x  cball x0 (d/3)" for t x
  proof -
    from that have "norm (f (t, x) - f (t0, x0)) < 1"
      using 0 < d
      unfolding dist_norm[symmetric]
      apply (cases "(t, x) = (t0, x0)", force)
      by (rule d) (auto simp: dist_commute dist_prod_def mem_cball
        intro!: le_less_trans[OF sqrt_sum_squares_le_sum_abs])
    then show ?thesis
      by norm
  qed
  have "norm (f (t0, x0)) + 1  1"
    "eventually (λe. x  cball t0 e × cball x0 e.
      norm (f x)  norm (f (t0, x0)) + 1) (at_right 0)"
    using d(1) bound
    by (auto simp: eventually_at dist_real_def mem_cball intro!: exI[where x="d/3"])
  thus ?thesis ..
qed

lemma
  eventually_in_cballs:
  assumes "d > 0" "c > 0"
  shows "eventually (λe. cball t0 (c * e) × (cball x0 e)  cball (t0, x0) d) (at_right 0)"
  using assms
  by (auto simp: eventually_at dist_real_def field_simps dist_prod_def mem_cball
    intro!: exI[where x="min d (d / c) / 3"]
    order_trans[OF sqrt_sum_squares_le_sum_abs])

lemma cball_eq_sing':
  fixes x :: "'a::{metric_space,perfect_space}"
  shows "cball x e = {y}  e = 0  x = y"
  using cball_eq_sing[of x e]
  apply (cases "x = y", force)
  by (metis cball_empty centre_in_cball insert_not_empty not_le singletonD)

locale ll_on_open = interval T for T +
  fixes f::"real  'a::{banach, heine_borel}  'a" and X
  assumes local_lipschitz: "local_lipschitz T X f"
  assumes cont: "x. x  X  continuous_on T (λt. f t x)"
  assumes open_domain[intro!, simp]: "open T" "open X"
begin

text ‹all flows on closed segments›

definition csols where
  "csols t0 x0 = {(x, t1). {t0--t1}  T  x t0 = x0  (x solves_ode f) {t0--t1} X}"

text ‹the maximal existence interval›

definition "existence_ivl t0 x0 = ((x, t1)csols t0 x0 . {t0--t1})"

text ‹witness flow›

definition "csol t0 x0 = (SOME csol. t  existence_ivl t0 x0. (csol t, t)  csols t0 x0)"

text ‹unique flow›

definition flow where "flow t0 x0 = (λt. if t  existence_ivl t0 x0 then csol t0 x0 t t else 0)"

end

locale ll_on_open_it =
  general?:― ‹TODO: why is this qualification necessary? It seems only because of @{thm ll_on_open_it_axioms}
  ll_on_open + fixes t0::real
  ― ‹if possible, all development should be done with t0› as explicit parameter for initial time:
    then it can be instantiated with 0› for autonomous ODEs›

context ll_on_open begin

sublocale ll_on_open_it where t0 = t0  for t0 ..

sublocale continuous_rhs T X f
  by unfold_locales (rule continuous_on_TimesI[OF local_lipschitz cont])

end

context ll_on_open_it begin

lemma ll_on_open_rev[intro, simp]: "ll_on_open (preflect t0 ` T) (λt. - f (preflect t0 t)) X"
  using local_lipschitz interval
  by unfold_locales
    (auto intro!: continuous_intros cont intro: local_lipschitz_compose1
      simp: fun_Compl_def local_lipschitz_minus local_lipschitz_subset open_neg_translation
        image_image preflect_def)

lemma eventually_lipschitz:
  assumes "t0  T" "x0  X" "c > 0"
  obtains L where
    "eventually (λu. t'  cball t0 (c * u)  T.
      L-lipschitz_on (cball x0 u  X) (λy. f t' y)) (at_right 0)"
proof -
  from local_lipschitzE[OF local_lipschitz, OF t0  T x0  X]
  obtain u L where
    "u > 0"
    "t'. t'  cball t0 u  T  L-lipschitz_on (cball x0 u  X) (λy. f t' y)"
    by auto
  hence "eventually (λu. t'  cball t0 (c * u)  T.
      L-lipschitz_on (cball x0 u  X) (λy. f t' y)) (at_right 0)"
    using u > 0 c > 0
    by (auto simp: dist_real_def eventually_at divide_simps algebra_simps
      intro!: exI[where x="min u (u / c)"]
      intro: lipschitz_on_subset[where E="cball x0 u  X"])
  thus ?thesis ..
qed

lemmas continuous_on_Times_f = continuous
lemmas continuous_on_f = continuous_rhs_comp

lemma
  lipschitz_on_compact:
  assumes "compact K" "K  T"
  assumes "compact Y" "Y  X"
  obtains L where "t. t  K  L-lipschitz_on Y (f t)"
proof -
  have cont: "x. x  Y  continuous_on K (λt. f t x)"
    using Y  X K  T
    by (auto intro!: continuous_on_f continuous_intros)
  from local_lipschitz
  have "local_lipschitz K Y f"
    by (rule local_lipschitz_subset[OF _ K  T Y  X])
  from local_lipschitz_compact_implies_lipschitz[OF this ‹compact Y ‹compact K cont] that
  show ?thesis by metis
qed

lemma csols_empty_iff: "csols t0 x0 = {}  t0  T  x0  X"
proof cases
  assume iv_defined: "t0  T  x0  X"
  then have "(λ_. x0, t0)  csols t0 x0"
    by (auto simp: csols_def intro!: solves_ode_singleton)
  then show ?thesis using t0  T  x0  X by auto
qed (auto simp: solves_ode_domainD csols_def)

lemma csols_notempty: "t0  T  x0  X  csols t0 x0  {}"
  by (simp add: csols_empty_iff)


lemma existence_ivl_empty_iff[simp]: "existence_ivl t0 x0 = {}  t0  T  x0  X"
  using csols_empty_iff
  by (auto simp: existence_ivl_def)

lemma existence_ivl_empty1[simp]: "t0  T  existence_ivl t0 x0 = {}"
  and existence_ivl_empty2[simp]: "x0  X  existence_ivl t0 x0 = {}"
  using csols_empty_iff
  by (auto simp: existence_ivl_def)

lemma flow_undefined:
  shows "t0  T  flow t0 x0 = (λ_. 0)"
    "x0  X  flow t0 x0 = (λ_. 0)"
  using existence_ivl_empty_iff
  by (auto simp: flow_def)

lemma (in ll_on_open) flow_eq_in_existence_ivlI:
  assumes "u. x0  X  u  existence_ivl t0 x0  g u  existence_ivl s0 x0"
  assumes "u. x0  X  u  existence_ivl t0 x0  flow t0 x0 u = flow s0 x0 (g u)"
  shows "flow t0 x0 = (λt. flow s0 x0 (g t))"
  apply (cases "x0  X")
  subgoal using assms by (auto intro!: ext simp: flow_def)
  subgoal by (simp add: flow_undefined)
  done


subsubsection ‹Global maximal flow with local Lipschitz›
text‹\label{sec:qpl-global-flow}›

lemma local_unique_solution:
  assumes iv_defined: "t0  T" "x0  X"
  obtains et ex B L
  where "et > 0" "0 < ex" "cball t0 et  T" "cball x0 ex  X"
    "unique_on_cylinder t0 (cball t0 et) x0 ex f B L"
proof -
  have "F e::real in at_right 0. 0 < e"
    by (auto simp: eventually_at_filter)
  moreover

  from open_Times[OF open_domain] have "open (T × X)" .
  from at_within_open[OF _ this] iv_defined
  have "isCont (λ(t, x). f t x) (t0, x0)"
    using continuous by (auto simp: continuous_on_eq_continuous_within)
  from eventually_bound_pairE[OF this]
  obtain B where B:
    "1  B" "F e in at_right 0. tcball t0 e. xcball x0 e. norm (f t x)  B"
    by (force simp: )
  note B(2)
  moreover

  define t where "t  inverse B"
  have te: "e. e > 0  t * e > 0"
    using 1  B by (auto simp: t_def field_simps)
  have t_pos: "t > 0"
    using 1  B by (auto simp: t_def)

  from B(2) obtain dB where "0 < dB" "0 < dB / 2"
    and dB: "d t x. 0 < d  d < dB  tcball t0 d  xcball x0 d 
      norm (f t x)  B"
    by (auto simp: eventually_at dist_real_def Ball_def)

  hence dB': "t x. (t, x)  cball (t0, x0) (dB / 2)  norm (f t x)  B"
    using cball_Pair_split_subset[of t0 x0 "dB / 2"]
    by (auto simp: eventually_at dist_real_def
      simp del: mem_cball
      intro!: dB[where d="dB/2"])
  from eventually_in_cballs[OF 0 < dB/2 t_pos, of t0 x0]
  have "F e in at_right 0. tcball t0 (t * e). xcball x0 e. norm (f t x)  B"
    unfolding eventually_at_filter
    by eventually_elim (auto intro!: dB')
  moreover

  from eventually_lipschitz[OF iv_defined t_pos] obtain L where
    "F u in at_right 0. t'cball t0 (t * u)  T. L-lipschitz_on (cball x0 u  X) (f t')"
    by auto
  moreover
  have "F e in at_right 0. cball t0 (t * e)  T"
    using eventually_open_cball[OF open_domain(1) iv_defined(1)]
    by (subst eventually_filtermap[symmetric, where f="λx. t * x"])
      (simp add: filtermap_times_pos_at_right t_pos)
  moreover
  have "eventually (λe. cball x0 e  X) (at_right 0)"
    using open_domain(2) iv_defined(2)
    by (rule eventually_open_cball)
  ultimately have "F e in at_right 0. 0 < e  cball t0 (t * e)  T  cball x0 e  X 
    unique_on_cylinder t0 (cball t0 (t * e)) x0 e f B L"
  proof eventually_elim
    case (elim e)
    note 0 < e
    moreover
    note T = ‹cball t0 (t * e)  T
    moreover
    note X = ‹cball x0 e  X
    moreover
    from elim Int_absorb2[OF ‹cball x0 e  X]
    have L: "t'  cball t0 (t * e)  T  L-lipschitz_on (cball x0 e) (f t')" for t'
      by auto
    from elim have B: "t' x. t'  cball t0 (t * e)  x  cball x0 e  norm (f t' x)  B"
      by auto


    have "t * e  e / B"
      by (auto simp: t_def cball_def dist_real_def inverse_eq_divide)

    have "{t0 -- t0 + t * e}  cball t0 (t * e)"
      using t > 0 e > 0
      by (auto simp: cball_eq_closed_segment_real closed_segment_eq_real_ivl)
    then have "unique_on_cylinder t0 (cball t0 (t * e)) x0 e f B L"
      using T X t > 0 e > 0 t * e  e / B
      by unfold_locales
        (auto intro!: continuous_rhs_comp continuous_on_fst continuous_on_snd B L
          continuous_on_id
          simp: split_beta' dist_commute mem_cball)
    ultimately show ?case by auto
  qed
  from eventually_happens[OF this]
  obtain e where "0 < e" "cball t0 (t * e)  T" "cball x0 e  X"
    "unique_on_cylinder t0 (cball t0 (t * e)) x0 e f B L"
    by (metis trivial_limit_at_right_real)
  with mult_pos_pos[OF 0 < t 0 < e] show ?thesis ..
qed

lemma mem_existence_ivl_iv_defined:
  assumes "t  existence_ivl t0 x0"
  shows "t0  T" "x0  X"
  using assms existence_ivl_empty_iff
  unfolding atomize_conj
  by blast

lemma csol_mem_csols:
  assumes "t  existence_ivl t0 x0"
  shows "(csol t0 x0 t, t)  csols t0 x0"
proof -
  have "csol. t  existence_ivl t0 x0. (csol t, t)  csols t0 x0"
  proof (safe intro!: bchoice)
    fix t assume "t  existence_ivl t0 x0"
    then obtain csol t1 where csol: "(csol t, t1)  csols t0 x0" "t  {t0 -- t1}"
      by (auto simp: existence_ivl_def)
    then have "{t0--t}  {t0 -- t1}"
      by (auto simp: closed_segment_eq_real_ivl)
    then have "(csol t, t)  csols t0 x0" using csol
      by (auto simp: csols_def intro: solves_ode_on_subset)
    then show "y. (y, t)  csols t0 x0" by force
  qed
  then have "t  existence_ivl t0 x0. (csol t0 x0 t, t)  csols t0 x0"
    unfolding csol_def
    by (rule someI_ex)
  with assms show "?thesis" by auto
qed

lemma csol:
  assumes "t  existence_ivl t0 x0"
  shows "t  T" "{t0--t}  T" "csol t0 x0 t t0 = x0" "(csol t0 x0 t solves_ode f) {t0--t} X"
  using csol_mem_csols[OF assms]
  by (auto simp: csols_def)

lemma existence_ivl_initial_time_iff[simp]: "t0  existence_ivl t0 x0  t0  T  x0  X"
  using csols_empty_iff
  by (auto simp: existence_ivl_def)

lemma existence_ivl_initial_time: "t0  T  x0  X  t0  existence_ivl t0 x0"
  by simp

lemmas mem_existence_ivl_subset = csol(1)

lemma existence_ivl_subset:
  "existence_ivl t0 x0  T"
  using mem_existence_ivl_subset by blast

lemma is_interval_existence_ivl[intro, simp]: "is_interval (existence_ivl t0 x0)"
  unfolding is_interval_connected_1
  by (auto simp: existence_ivl_def intro!: connected_Union)

lemma connected_existence_ivl[intro, simp]: "connected (existence_ivl t0 x0)"
  using is_interval_connected by blast

lemma in_existence_between_zeroI:
  "t  existence_ivl t0 x0  s  {t0 -- t}  s  existence_ivl t0 x0"
  by (meson existence_ivl_initial_time interval.closed_segment_subset_domainI interval.intro
    is_interval_existence_ivl mem_existence_ivl_iv_defined(1) mem_existence_ivl_iv_defined(2))

lemma segment_subset_existence_ivl:
  assumes "s  existence_ivl t0 x0" "t  existence_ivl t0 x0"
  shows "{s -- t}  existence_ivl t0 x0"
  using assms is_interval_existence_ivl
  unfolding is_interval_convex_1
  by (rule closed_segment_subset)

lemma flow_initial_time_if: "flow t0 x0 t0 = (if t0  T  x0  X then x0 else 0)"
  by (simp add: flow_def csol(3))

lemma flow_initial_time[simp]: "t0  T  x0  X  flow t0 x0 t0 = x0"
  by (auto simp: flow_initial_time_if)

lemma open_existence_ivl[intro, simp]: "open (existence_ivl t0 x0)"
proof (rule openI)
  fix t assume t: "t  existence_ivl t0 x0"
  note csol = csol[OF this]
  note mem_existence_ivl_iv_defined[OF t]

  have "flow t0 x0 t  X" using t  existence_ivl t0 x0
    using csol(4) solves_ode_domainD
    by (force simp add: flow_def)

  from ll_on_open_it.local_unique_solution[OF ll_on_open_it_axioms t  T this]
  obtain et ex B L where lsol:
    "0 < et"
    "0 < ex"
    "cball t et  T"
    "cball (flow t0 x0 t) ex  X"
    "unique_on_cylinder t (cball t et) (flow t0 x0 t) ex f B L"
    by metis
  then interpret unique_on_cylinder t "cball t et" "flow t0 x0 t" ex "cball (flow t0 x0 t) ex" f B L
    by auto
  from solution_usolves_ode have lsol_ode: "(solution solves_ode f) (cball t et) (cball (flow t0 x0 t) ex)"
    by (intro usolves_odeD)
  show "e>0. ball t e  existence_ivl t0 x0"
  proof cases
    assume "t = t0"
    show ?thesis
    proof (safe intro!: exI[where x="et"] mult_pos_pos 0 < et 0 < ex)
      fix t' assume "t'  ball t et"
      then have subset: "{t0--t'}  ball t et"
        by (intro closed_segment_subset) (auto simp: 0 < et 0 < ex t = t0)
      also have "  cball t et" by simp
      also note ‹cball t _  T
      finally have "{t0--t'}  T" by simp
      moreover have "(solution solves_ode f) {t0--t'} X"
        using lsol_ode
        apply (rule solves_ode_on_subset)
        using subset lsol
        by (auto simp: mem_ball mem_cball)
      ultimately have "(solution, t')  csols t0 x0"
        unfolding csols_def
        using lsol t'  ball _ _ lsol t = t0 solution_iv x0  X
        by (auto simp: csols_def)
      then show "t'  existence_ivl t0 x0"
        unfolding existence_ivl_def
        by force
    qed
  next
    assume "t  t0"
    let ?m = "min et (dist t0 t / 2)"
    show ?thesis
    proof (safe intro!: exI[where x = ?m])
      let ?t1' = "if t0  t then t + et else t - et"
      have lsol_ode: "(solution solves_ode f) {t -- ?t1'} (cball (flow t0 x0 t) ex)"
        by (rule solves_ode_on_subset[OF lsol_ode])
          (insert 0 < et 0 < ex, auto simp: mem_cball closed_segment_eq_real_ivl dist_real_def)
      let ?if = "λta. if ta  {t0--t} then csol t0 x0 t ta else solution ta"
      let ?iff = "λta. if ta  {t0--t} then f ta else f ta"
      have "(?if solves_ode ?iff) ({t0--t}  {t -- ?t1'}) X"
        apply (rule connection_solves_ode[OF csol(4) lsol_ode, unfolded Un_absorb2[OF _  X]])
        using lsol solution_iv t  existence_ivl t0 x0
        by (auto intro!: simp: closed_segment_eq_real_ivl flow_def split: if_split_asm)
      also have "?iff = f" by auto
      also have Un_eq: "{t0--t}  {t -- ?t1'} = {t0 -- ?t1'}"
        using 0 < et 0 < ex
        by (auto simp: closed_segment_eq_real_ivl)
      finally have continuation: "(?if solves_ode f) {t0--?t1'} X" .
      have subset_T: "{t0 -- ?t1'}  T"
        unfolding Un_eq[symmetric]
        apply (intro Un_least)
        subgoal using csol by force
        subgoal using _ lsol(3)
          apply (rule order_trans)
          using 0 < et 0 < ex
          by (auto simp: closed_segment_eq_real_ivl subset_iff mem_cball dist_real_def)
        done
      fix t' assume "t'  ball t ?m"
      then have scs: "{t0 -- t'}  {t0--?t1'}"
        using 0 < et 0 < ex
        by (auto simp: closed_segment_eq_real_ivl dist_real_def abs_real_def mem_ball split: if_split_asm)
      with continuation have "(?if solves_ode f) {t0 -- t'} X"
        by (rule solves_ode_on_subset) simp
      then have "(?if, t')  csols t0 x0"
        using lsol t'  ball _ _ csol scs subset_T
        by (auto simp: csols_def subset_iff)
      then show "t'  existence_ivl t0 x0"
        unfolding existence_ivl_def
        by force
    qed (insert t  t0 0 < et 0 < ex, simp)
  qed
qed

lemma csols_unique:
  assumes "(x, t1)  csols t0 x0"
  assumes "(y, t2)  csols t0 x0"
  shows "t  {t0 -- t1}  {t0 -- t2}. x t = y t"
proof (rule ccontr)
  let ?S = "{t0 -- t1}  {t0 -- t2}"
  let ?Z0 = "(λt. x t - y t) -` {0}  ?S"
  let ?Z = "connected_component_set ?Z0 t0"
  from assms have t1: "t1  existence_ivl t0 x0" and t2: "t2  existence_ivl t0 x0"
    and x: "(x solves_ode f) {t0 -- t1} X"
    and y: "(y solves_ode f) {t0 -- t2} X"
    and sub1: "{t0--t1}  T"
    and sub2: "{t0--t2}  T"
    and x0: "x t0 = x0"
    and y0: "y t0 = x0"
    by (auto simp: existence_ivl_def csols_def)

  assume "¬ (t?S. x t = y t)"
  hence "t?S. x t  y t" by simp
  then obtain t_ne where t_ne: "t_ne  ?S" "x t_ne  y t_ne" ..
  from assms have x: "(x solves_ode f) {t0--t1} X"
    and y:"(y solves_ode f) {t0--t2} X"
    by (auto simp: csols_def)
  have "compact ?S"
    by auto
  have "closed ?Z"
    by (intro closed_connected_component closed_vimage_Int)
      (auto intro!: continuous_intros continuous_on_subset[OF solves_ode_continuous_on[OF x]]
        continuous_on_subset[OF solves_ode_continuous_on[OF y]])
  moreover
  have "t0  ?Z" using assms
    by (auto simp: csols_def)
  then have "?Z  {}"
    by (auto intro!: exI[where x=t0])
  ultimately
  obtain t_max where max: "t_max  ?Z" "y  ?Z  dist t_ne t_max  dist t_ne y" for y
    by (blast intro: distance_attains_inf)
  have max_equal_flows: "x t = y t" if "t  {t0 -- t_max}" for t
    using max(1) that
    by (auto simp: connected_component_def vimage_def subset_iff closed_segment_eq_real_ivl
      split: if_split_asm) (metis connected_iff_interval)+
  then have t_ne_outside: "t_ne  {t0 -- t_max}" using t_ne by auto

  have "x t_max = y t_max"
    by (rule max_equal_flows) simp
  have "t_max  ?S" "t_max  T"
    using max sub1 sub2
    by (auto simp: connected_component_def)
  with solves_odeD[OF x]
  have "x t_max  X"
    by auto

  from ll_on_open_it.local_unique_solution[OF ll_on_open_it_axioms t_max  T x t_max  X]
  obtain et ex B L
    where "0 < et" "0 < ex"
      and "cball t_max et  T" "cball (x t_max) ex  X"
      and "unique_on_cylinder t_max (cball t_max et) (x t_max) ex f B L"
    by metis
  then interpret unique_on_cylinder t_max "cball t_max et" "x t_max" ex "cball (x t_max) ex" f B L
    by auto

  from usolves_ode_on_superset_domain[OF solution_usolves_ode solution_iv ‹cball _ _  X]
  have solution_usolves_on_X: "(solution usolves_ode f from t_max) (cball t_max et) X" by simp

  have ge_imps: "t0  t1" "t0  t2" "t0  t_max" "t_max < t_ne" if "t0  t_ne"
    using that t_ne_outside 0 < et 0 < ex max(1) t_max  ?S t_max  T t_ne x0 y0
    by (auto simp: min_def dist_real_def max_def closed_segment_eq_real_ivl split: if_split_asm)
  have le_imps: "t0  t1" "t0  t2" "t0  t_max" "t_max > t_ne" if "t0  t_ne"
    using that t_ne_outside 0 < et 0 < ex max(1) t_max  ?S t_max  T t_ne x0 y0
    by (auto simp: min_def dist_real_def max_def closed_segment_eq_real_ivl split: if_split_asm)

  define tt where "tt  if t0  t_ne then min (t_max + et) t_ne else max (t_max - et) t_ne"
  have "tt  cball t_max et" "tt  {t0 -- t1}" "tt  {t0 -- t2}"
    using ge_imps le_imps 0 < et t_ne(1)
    by (auto simp: mem_cball closed_segment_eq_real_ivl tt_def dist_real_def abs_real_def min_def max_def not_less)

  have segment_unsplit: "{t0 -- t_max}  {t_max -- tt} = {t0 -- tt}"
    using ge_imps le_imps 0 < et
    by (auto simp: tt_def closed_segment_eq_real_ivl min_def max_def split: if_split_asm) arith

  have "tt  {t0 -- t1}"
    using ge_imps le_imps 0 < et t_ne(1)
    by (auto simp: tt_def closed_segment_eq_real_ivl min_def max_def split: if_split_asm)

  have "tt  ?Z"
  proof (safe intro!: connected_componentI[where T = "{t0 -- t_max}  {t_max -- tt}"])
    fix s assume s: "s  {t_max -- tt}"
    have "{t_max--s}  {t_max -- tt}"
      by (rule closed_segment_subset) (auto simp: s)
    also have "  cball t_max et"
      using tt  cball t_max et 0 < et
      by (intro closed_segment_subset) auto
    finally have subset: "{t_max--s}  cball t_max et" .
    from s show "s  {t0--t1}" "s  {t0--t2}"
      using ge_imps le_imps t_ne 0 < et
      by (auto simp: tt_def min_def max_def closed_segment_eq_real_ivl split: if_split_asm)
    have ivl: "t_max  {t_max -- s}" "is_interval {t_max--s}"
      using tt  cball t_max et 0 < et s
      by (simp_all add: is_interval_convex_1)
    {
      note ivl subset
      moreover
      have "{t_max--s}  {t0--t1}"
        using s  {t0 -- t1} t_max  ?S
        by (simp add: closed_segment_subset)
      from x this order_refl have "(x solves_ode f) {t_max--s} X"
        by (rule solves_ode_on_subset)
      moreover note solution_iv[symmetric]
      ultimately
      have "x s = solution s"
        by (rule usolves_odeD(4)[OF solution_usolves_on_X]) simp
    } moreover {
      note ivl subset
      moreover
      have "{t_max--s}  {t0--t2}"
        using s  {t0 -- t2} t_max  ?S
        by (simp add: closed_segment_subset)
      from y this order_refl have "(y solves_ode f) {t_max--s} X"
        by (rule solves_ode_on_subset)
      moreover from solution_iv[symmetric] have "y t_max = solution t_max"
        by (simp add: x t_max = y t_max)
      ultimately
      have "y s = solution s"
        by (rule usolves_odeD[OF solution_usolves_on_X]) simp
    } ultimately show "s  (λt. x t - y t) -` {0}" by simp
  next
    fix s assume s: "s  {t0 -- t_max}"
    then show "s  (λt. x t - y t) -` {0}"
      by (auto intro!: max_equal_flows)
    show "s  {t0--t1}" "s  {t0--t2}"
      by (metis Int_iff t_max  ?S closed_segment_closed_segment_subset ends_in_segment(1) s)+
  qed (auto simp: segment_unsplit)
  then have "dist t_ne t_max  dist t_ne tt"
    by (rule max)
  moreover have "dist t_ne t_max > dist t_ne tt"
    using le_imps ge_imps 0 < et
    by (auto simp: tt_def dist_real_def)
  ultimately show False by simp
qed

lemma csol_unique:
  assumes t1: "t1  existence_ivl t0 x0"
  assumes t2: "t2  existence_ivl t0 x0"
  assumes t: "t  {t0 -- t1}" "t  {t0 -- t2}"
  shows "csol t0 x0 t1 t = csol t0 x0 t2 t"
  using csols_unique[OF csol_mem_csols[OF t1] csol_mem_csols[OF t2]] t
  by simp

lemma flow_vderiv_on_left:
  "(flow t0 x0 has_vderiv_on (λx. f x (flow t0 x0 x))) (existence_ivl t0 x0  {..t0})"
  unfolding has_vderiv_on_def
proof safe
  fix t
  assume t: "t  existence_ivl t0 x0" "t  t0"
  with open_existence_ivl
  obtain e where "e > 0" and e: "s. s  cball t e  s  existence_ivl t0 x0"
    by (force simp: open_contains_cball)
  have csol_eq: "csol t0 x0 (t - e) s = flow t0 x0 s" if "t - e  s" "s  t0" for s
    unfolding flow_def
    using that 0 < e t e
    by (auto simp: cball_def dist_real_def abs_real_def closed_segment_eq_real_ivl subset_iff
      intro!: csol_unique in_existence_between_zeroI[of "t - e" x0 s]
      split: if_split_asm)
  from e[of "t - e"] 0 < e have "t - e  existence_ivl t0 x0" by (auto simp: mem_cball)

  let ?l = "existence_ivl t0 x0  {..t0}"
  let ?s = "{t0 -- t - e}"

  from csol(4)[OF e[of "t - e"]] 0 < e
  have 1: "(csol t0 x0 (t - e) solves_ode f) ?s X"
    by (auto simp: mem_cball)
  have "t  {t0 -- t - e}" using t 0 < e by (auto simp: closed_segment_eq_real_ivl)
  from solves_odeD(1)[OF 1, unfolded has_vderiv_on_def, rule_format, OF this]
  have "(csol t0 x0 (t - e) has_vector_derivative f t (csol t0 x0 (t - e) t)) (at t within ?s)" .
  also have "at t within ?s = (at t within ?l)"
    using t 0 < e
    by (intro at_within_nhd[where S="{t - e <..< t0 + 1}"])
      (auto simp: closed_segment_eq_real_ivl intro!: in_existence_between_zeroI[OF t - e  existence_ivl t0 x0])
  finally
  have "(csol t0 x0 (t - e) has_vector_derivative f t (csol t0 x0 (t - e) t)) (at t within existence_ivl t0 x0  {..t0})" .
  also have "csol t0 x0 (t - e) t = flow t0 x0 t"
    using 0 < e t  t0 by (auto intro!: csol_eq)
  finally
  show "(flow t0 x0 has_vector_derivative f t (flow t0 x0 t)) (at t within existence_ivl t0 x0  {..t0})"
    apply (rule has_vector_derivative_transform_within[where d=e])
    using t 0 < e
    by (auto intro!: csol_eq simp: dist_real_def)
qed

lemma flow_vderiv_on_right:
  "(flow t0 x0 has_vderiv_on (λx. f x (flow t0 x0 x))) (existence_ivl t0 x0  {t0..})"
  unfolding has_vderiv_on_def
proof safe
  fix t
  assume t: "t  existence_ivl t0 x0" "t0  t"
  with open_existence_ivl
  obtain e where "e > 0" and e: "s. s  cball t e  s  existence_ivl t0 x0"
    by (force simp: open_contains_cball)
  have csol_eq: "csol t0 x0 (t + e) s = flow t0 x0 s" if "s  t + e" "t0  s" for s
    unfolding flow_def
    using e that 0 < e
    by (auto simp: cball_def dist_real_def abs_real_def closed_segment_eq_real_ivl subset_iff
      intro!: csol_unique in_existence_between_zeroI[of "t + e" x0 s]
      split: if_split_asm)
  from e[of "t + e"] 0 < e have "t + e  existence_ivl t0 x0" by (auto simp: mem_cball dist_real_def)

  let ?l = "existence_ivl t0 x0  {t0..}"
  let ?s = "{t0 -- t + e}"

  from csol(4)[OF e[of "t + e"]] 0 < e
  have 1: "(csol t0 x0 (t + e) solves_ode f) ?s X"
    by (auto simp: dist_real_def mem_cball)
  have "t  {t0 -- t + e}" using t 0 < e by (auto simp: closed_segment_eq_real_ivl)
  from solves_odeD(1)[OF 1, unfolded has_vderiv_on_def, rule_format, OF this]
  have "(csol t0 x0 (t + e) has_vector_derivative f t (csol t0 x0 (t + e) t)) (at t within ?s)" .
  also have "at t within ?s = (at t within ?l)"
    using t 0 < e
    by (intro at_within_nhd[where S="{t0 - 1 <..< t + e}"])
      (auto simp: closed_segment_eq_real_ivl intro!: in_existence_between_zeroI[OF t + e  existence_ivl t0 x0])
  finally
  have "(csol t0 x0 (t + e) has_vector_derivative f t (csol t0 x0 (t + e) t)) (at t within ?l)" .
  also have "csol t0 x0 (t + e) t = flow t0 x0 t"
    using 0 < e t0  t by (auto intro!: csol_eq)
  finally
  show "(flow t0 x0 has_vector_derivative f t (flow t0 x0 t)) (at t within ?l)"
    apply (rule has_vector_derivative_transform_within[where d=e])
    using t 0 < e
    by (auto intro!: csol_eq simp: dist_real_def)
qed

lemma flow_usolves_ode:
  assumes iv_defined: "t0  T" "x0  X"
  shows "(flow t0 x0 usolves_ode f from t0) (existence_ivl t0 x0) X"
proof (rule usolves_odeI)
  let ?l = "existence_ivl t0 x0  {..t0}" and ?r = "existence_ivl t0 x0  {t0..}"
  let ?split = "?l  ?r"
  have insert_idem: "insert t0 ?l = ?l" "insert t0 ?r = ?r" using iv_defined
    by auto
  from existence_ivl_initial_time have cl_inter: "closure ?l  closure ?r = {t0}"
  proof safe
    from iv_defined have "t0  ?l" by simp also note closure_subset finally show "t0  closure ?l" .
    from iv_defined have "t0  ?r" by simp also note closure_subset finally show "t0  closure ?r" .
    fix x
    assume xl: "x  closure ?l"
    assume "x  closure ?r"
    also have "closure ?r  closure {t0..}"
      by (rule closure_mono) simp
    finally have "t0  x" by simp
    moreover
    {
      note xl
      also have cl: "closure ?l  closure {..t0}"
        by (rule closure_mono) simp
      finally have "x  t0" by simp
    } ultimately show "x = t0" by simp
  qed
  have "(flow t0 x0 has_vderiv_on (λt. f t (flow t0 x0 t))) ?split"
    by (rule has_vderiv_on_union)
      (auto simp: cl_inter insert_idem flow_vderiv_on_right flow_vderiv_on_left)
  also have "?split = existence_ivl t0 x0"
    by auto
  finally have "(flow t0 x0 has_vderiv_on (λt. f t (flow t0 x0 t))) (existence_ivl t0 x0)" .
  moreover
  have "flow t0 x0 t  X" if "t  existence_ivl t0 x0" for t
    using solves_odeD(2)[OF csol(4)[OF that]] that
    by (simp add: flow_def)
  ultimately show "(flow t0 x0 solves_ode f) (existence_ivl t0 x0) X"
    by (rule solves_odeI)
  show "t0  existence_ivl t0 x0" using iv_defined by simp
  show "is_interval (existence_ivl t0 x0)" by (simp add: is_interval_existence_ivl)
  fix z t
  assume z: "{t0 -- t}  existence_ivl t0 x0" "(z solves_ode f) {t0 -- t} X" "z t0 = flow t0 x0 t0"
  then have "t  existence_ivl t0 x0" by auto
  moreover
  from csol[OF this] z have "(z, t)  csols t0 x0" by (auto simp: csols_def)
  moreover have "(csol t0 x0 t, t)  csols t0 x0"
    by (rule csol_mem_csols) fact
  ultimately
  show "z t = flow t0 x0 t"
    unfolding flow_def
    by (auto intro: csols_unique[rule_format])
qed

lemma flow_solves_ode: "t0  T  x0  X  (flow t0 x0 solves_ode f) (existence_ivl t0 x0) X"
  by (rule usolves_odeD[OF flow_usolves_ode])

lemma equals_flowI:
  assumes "t0  T'"
    "is_interval T'"
    "T'  existence_ivl t0 x0"
    "(z solves_ode f) T' X"
    "z t0 = flow t0 x0 t0" "t  T'"
  shows "z t = flow t0 x0 t"
proof -
  from assms have iv_defined: "t0  T" "x0  X"
    unfolding atomize_conj
    using assms existence_ivl_subset mem_existence_ivl_iv_defined
    by blast
  show ?thesis
    using assms
    by (rule usolves_odeD[OF flow_usolves_ode[OF iv_defined]])
qed

lemma existence_ivl_maximal_segment:
  assumes "(x solves_ode f) {t0 -- t} X" "x t0 = x0"
  assumes "{t0 -- t}  T"
  shows "t  existence_ivl t0 x0"
  using assms
  by (auto simp: existence_ivl_def csols_def)

lemma existence_ivl_maximal_interval:
  assumes "(x solves_ode f) S X" "x t0 = x0"
  assumes "t0  S" "is_interval S" "S  T"
  shows "S  existence_ivl t0 x0"
proof
  fix t assume "t  S"
  with assms have subset1: "{t0--t}  S"
    by (intro closed_segment_subset) (auto simp: is_interval_convex_1)
  with S  T have subset2: "{t0 -- t}  T" by auto
  have "(x solves_ode f) {t0 -- t} X"
    using assms(1) subset1 order_refl
    by (rule solves_ode_on_subset)
  from this x t0 = x0 subset2 show "t  existence_ivl t0 x0"
    by (rule existence_ivl_maximal_segment)
qed

lemma maximal_existence_flow:
  assumes sol: "(x solves_ode f) K X" and iv: "x t0 = x0"
  assumes "is_interval K"
  assumes "t0  K"
  assumes "K  T"
  shows "K  existence_ivl t0 x0" "t. t  K  flow t0 x0 t = x t"
proof -
  from assms have iv_defined: "t0  T" "x0  X"
    unfolding atomize_conj
    using solves_ode_domainD by blast
  show exivl: "K  existence_ivl t0 x0"
    by (rule existence_ivl_maximal_interval; rule assms)
  show "flow t0 x0 t = x t" if "t  K" for t
    apply (rule sym)
    apply (rule equals_flowI[OF t0  K ‹is_interval K exivl sol _ that])
    by (simp add: iv iv_defined)
qed

lemma maximal_existence_flowI:
  assumes "(x has_vderiv_on (λt. f t (x t))) K"
  assumes "t. t  K  x t  X"
  assumes "x t0 = x0"
  assumes K: "is_interval K" "t0  K" "K  T"
  shows "K  existence_ivl t0 x0" "t. t  K  flow t0 x0 t = x t"
proof -
  from assms(1,2) have sol: "(x solves_ode f) K X" by (rule solves_odeI)
  from maximal_existence_flow[OF sol assms(3) K]
  show "K  existence_ivl t0 x0" "t. t  K  flow t0 x0 t = x t"
    by auto
qed

lemma flow_in_domain: "t  existence_ivl t0 x0  flow t0 x0 t  X"
  using flow_solves_ode solves_ode_domainD local.mem_existence_ivl_iv_defined
  by blast

lemma (in ll_on_open)
  assumes "t  existence_ivl s x"
  assumes "x  X"
  assumes auto: "s t x. x  X  f s x = f t x"
  assumes "T = UNIV"
  shows mem_existence_ivl_shift_autonomous1: "t - s  existence_ivl 0 x"
    and flow_shift_autonomous1: "flow s x t = flow 0 x (t - s)"
proof -
  have na: "s  T" "x  X" and a: "0  T" "x  X"
    by (auto simp: assms)

  have tI[simp]: "t  T" for t by (simp add: assms)
  let ?T = "((+) (- s) ` existence_ivl s x)"
  have shifted: "is_interval ?T" "0  ?T"
    by (auto simp: x  X)

  have "(λt. t - s) = (+) (- s)" by auto
  with shift_autonomous_solution[OF flow_solves_ode[OF na], of s] flow_in_domain
  have sol: "((λt. flow s x (t + s)) solves_ode f) ?T X"
    by (auto simp: auto x  X)

  have "flow s x (0 + s) = x" using x  X flow_initial_time by simp
  from maximal_existence_flow[OF sol this shifted]
  have *: "?T  existence_ivl 0 x"
    and **: "t. t  ?T  flow 0 x t = flow s x (t + s)"
    by (auto simp: subset_iff)

  have "t - s  ?T"
    using t  existence_ivl s x
    by auto
  also note *
  finally show "t - s  existence_ivl 0 x" .

  show "flow s x t = flow 0 x (t - s)"
    using t  existence_ivl s x
    by (auto simp: **)
qed

lemma (in ll_on_open)
  assumes "t - s  existence_ivl 0 x"
  assumes "x  X"
  assumes auto: "s t x. x  X  f s x = f t x"
  assumes "T = UNIV"
  shows mem_existence_ivl_shift_autonomous2: "t  existence_ivl s x"
    and flow_shift_autonomous2: "flow s x t = flow 0 x (t - s)"
proof -
  have na: "s  T" "x  X" and a: "0  T" "x  X"
    by (auto simp: assms)

  let ?T = "((+) s ` existence_ivl 0 x)"
  have shifted: "is_interval ?T" "s  ?T"
    by (auto simp: a)

  have "(λt. t + s) = (+) s"
    by (auto simp: )
  with shift_autonomous_solution[OF flow_solves_ode[OF a], of "-s"]
    flow_in_domain
  have sol: "((λt. flow 0 x (t - s)) solves_ode f) ?T X"
    by (auto simp: auto algebra_simps)

  have "flow 0 x (s - s) = x"
    by (auto simp: a)
  from maximal_existence_flow[OF sol this shifted]
  have *: "?T  existence_ivl s x"
    and **: "t. t  ?T  flow s x t = flow 0 x (t - s)"
    by (auto simp: subset_iff assms)

  have "t  ?T"
    using t - s  existence_ivl 0 x
    by force
  also note *
  finally show "t  existence_ivl s x" .

  show "flow s x t = flow 0 x (t - s)"
    using t - s  existence_ivl _ _
    by (subst **; force)
qed

lemma
  flow_eq_rev:
  assumes "t  existence_ivl t0 x0"
  shows "preflect t0 t  ll_on_open.existence_ivl (preflect t0 ` T) (λt. - f (preflect t0 t)) X t0 x0"
    "flow t0 x0 t = ll_on_open.flow (preflect t0 ` T) (λt. - f (preflect t0 t)) X t0 x0 (preflect t0 t)"
proof -
  from mem_existence_ivl_iv_defined[OF assms] have mt0: "t0  preflect t0 ` existence_ivl t0 x0"
    by (auto simp: preflect_def)
  have subset: "preflect t0 ` existence_ivl t0 x0  preflect t0 ` T"
    using existence_ivl_subset
    by (rule image_mono)
  from mt0 subset have "t0  preflect t0 ` T" by auto

  have sol: "((λt. flow t0 x0 (preflect t0 t)) solves_ode (λt. - f (preflect t0 t))) (preflect t0 ` existence_ivl t0 x0) X"
    using mt0
    by (rule preflect_solution) (auto simp: image_image flow_solves_ode mem_existence_ivl_iv_defined[OF assms])

  have flow0: "flow t0 x0 (preflect t0 t0) = x0" and ivl: "is_interval (preflect t0 ` existence_ivl t0 x0)"
    by (auto simp: preflect_def mem_existence_ivl_iv_defined[OF assms])

  interpret rev: ll_on_open "(preflect t0 ` T)" "(λt. - f (preflect t0 t))" X ..
  from rev.maximal_existence_flow[OF sol flow0 ivl mt0 subset]
  show "preflect t0 t  rev.existence_ivl t0 x0" "flow t0 x0 t = rev.flow t0 x0 (preflect t0 t)"
    using assms by (auto simp: preflect_def)
qed

lemma (in ll_on_open)
  shows rev_flow_eq: "t  ll_on_open.existence_ivl (preflect t0 ` T) (λt. - f (preflect t0 t)) X t0 x0 
    ll_on_open.flow (preflect t0 ` T) (λt. - f (preflect t0 t)) X t0 x0 t = flow t0 x0 (preflect t0 t)"
  and mem_rev_existence_ivl_eq:
  "t  ll_on_open.existence_ivl (preflect t0 ` T) (λt. - f (preflect t0 t)) X t0 x0  preflect t0 t  existence_ivl t0 x0"
proof -
  interpret rev: ll_on_open "(preflect t0 ` T)" "(λt. - f (preflect t0 t))" X ..
  from rev.flow_eq_rev[of _ t0 x0] flow_eq_rev[of "2 * t0 - t" t0 x0]
  show "t  rev.existence_ivl t0 x0  rev.flow t0 x0 t = flow t0 x0 (preflect t0 t)"
    "(t  rev.existence_ivl t0 x0) = (preflect t0 t  existence_ivl t0 x0)"
    by (auto simp: preflect_def fun_Compl_def image_image dest: mem_existence_ivl_iv_defined
      rev.mem_existence_ivl_iv_defined)
qed

lemma
  shows rev_existence_ivl_eq: "ll_on_open.existence_ivl (preflect t0 ` T) (λt. - f (preflect t0 t)) X t0 x0 = preflect t0 ` existence_ivl t0 x0"
    and existence_ivl_eq_rev: "existence_ivl t0 x0 = preflect t0 ` ll_on_open.existence_ivl (preflect t0 ` T) (λt. - f (preflect t0 t)) X t0 x0"
  apply safe
  subgoal by (force simp: mem_rev_existence_ivl_eq)
  subgoal by (force simp: mem_rev_existence_ivl_eq)
  subgoal for x by (force intro!: image_eqI[where x="preflect t0 x"] simp: mem_rev_existence_ivl_eq)
  subgoal by (force simp: mem_rev_existence_ivl_eq)
  done

end

end

Theory Bounded_Linear_Operator

section ‹Bounded Linear Operator›
theory Bounded_Linear_Operator
imports
  "HOL-Analysis.Analysis"
begin

typedef (overloaded) 'a blinop = "UNIV::('a, 'a) blinfun set"
by simp

setup_lifting type_definition_blinop

lift_definition blinop_apply::"('a::real_normed_vector) blinop  'a  'a" is blinfun_apply .
lift_definition Blinop::"('a::real_normed_vector  'a)  'a blinop" is Blinfun .

no_notation vec_nth (infixl "$" 90)
notation blinop_apply (infixl "$" 999)
declare [[coercion "blinop_apply :: ('a::real_normed_vector) blinop  'a  'a"]]

instantiation blinop :: (real_normed_vector) real_normed_vector
begin

lift_definition norm_blinop :: "'a blinop  real" is norm .

lift_definition minus_blinop :: "'a blinop  'a blinop  'a blinop" is minus .

lift_definition dist_blinop :: "'a blinop  'a blinop  real" is dist .

definition uniformity_blinop :: "('a blinop × 'a blinop) filter" where
  "uniformity_blinop = (INF e{0<..}. principal {(x, y). dist x y < e})"

definition open_blinop :: "'a blinop set  bool" where
  "open_blinop U = (xU. F (x', y) in uniformity. x' = x  y  U)"

lift_definition uminus_blinop :: "'a blinop  'a blinop" is uminus .

lift_definition zero_blinop :: "'a blinop" is 0 .

lift_definition plus_blinop :: "'a blinop  'a blinop  'a blinop" is plus .

lift_definition scaleR_blinop::"real  'a blinop  'a blinop" is scaleR .

lift_definition sgn_blinop :: "'a blinop  'a blinop" is sgn .

instance
  apply standard
  apply (transfer', simp add: algebra_simps sgn_div_norm open_uniformity norm_triangle_le
    uniformity_blinop_def dist_norm
    open_blinop_def)+
  done
end


lemma bounded_bilinear_blinop_apply: "bounded_bilinear ($)"
  unfolding bounded_bilinear_def
  by transfer (simp add: blinfun.bilinear_simps blinfun.bounded)

interpretation blinop: bounded_bilinear "($)"
  by (rule bounded_bilinear_blinop_apply)

lemma blinop_eqI: "(i. x $ i = y $ i)  x = y"
  by transfer (rule blinfun_eqI)

lemmas bounded_linear_apply_blinop[intro, simp] = blinop.bounded_linear_left
declare blinop.tendsto[tendsto_intros]
declare blinop.FDERIV[derivative_intros]
declare blinop.continuous[continuous_intros]
declare blinop.continuous_on[continuous_intros]

instance blinop :: (banach) banach
  apply standard
  unfolding convergent_def LIMSEQ_def Cauchy_def
  apply transfer
  unfolding convergent_def[symmetric] LIMSEQ_def[symmetric] Cauchy_def[symmetric]
    Cauchy_convergent_iff
  .

instance blinop :: (euclidean_space) heine_borel
  apply standard
  unfolding LIMSEQ_def bounded_def
  apply transfer
  unfolding LIMSEQ_def[symmetric] bounded_def[symmetric]
  apply (rule bounded_imp_convergent_subsequence)
  .

instantiation blinop::("{real_normed_vector, perfect_space}") real_normed_algebra_1
begin

lift_definition one_blinop::"'a blinop" is id_blinfun .
lemma blinop_apply_one_blinop[simp]: "1 $ x = x"
  by transfer simp

lift_definition times_blinop :: "'a blinop  'a blinop  'a blinop" is blinfun_compose .

lemma blinop_apply_times_blinop[simp]: "(f * g) $ x = f $ (g $ x)"
  by transfer simp

instance
proof
  from not_open_singleton[of "0::'a"] have "{0::'a}  UNIV" by force
  then obtain x :: 'a where "x  0" by auto
  show "0  (1::'a blinop)"
    apply transfer
    apply transfer
    apply (auto dest!: fun_cong[where x=x] simp: x  0)
    done
qed (transfer, transfer,
  simp add: o_def linear_simps onorm_compose onorm_id onorm_compose[simplified o_def])+
end

lemmas bounded_bilinear_bounded_uniform_limit_intros[uniform_limit_intros] =
  bounded_bilinear.bounded_uniform_limit[OF Bounded_Linear_Operator.bounded_bilinear_blinop_apply]
  bounded_bilinear.bounded_uniform_limit[OF Bounded_Linear_Function.bounded_bilinear_blinfun_apply]
  bounded_bilinear.bounded_uniform_limit[OF Bounded_Linear_Operator.blinop.flip]
  bounded_bilinear.bounded_uniform_limit[OF Bounded_Linear_Function.blinfun.flip]
  bounded_linear.uniform_limit[OF blinop.bounded_linear_right]
  bounded_linear.uniform_limit[OF blinop.bounded_linear_left]
  bounded_linear.uniform_limit[OF bounded_linear_apply_blinop]

no_notation
  blinop_apply (infixl "$" 999)
notation vec_nth (infixl "$" 90)

end

Theory Multivariate_Taylor

section ‹Multivariate Taylor›
theory Multivariate_Taylor
imports
  "HOL-Analysis.Analysis"
  "../ODE_Auxiliarities"
begin

no_notation vec_nth (infixl "$" 90)
notation blinfun_apply (infixl "$" 999)

lemma
  fixes f::"'a::real_normed_vector  'b::banach"
    and Df::"'a  nat  'a  'a  'b"
  assumes "n > 0"
  assumes Df_Nil: "a x. Df a 0 H H = f a"
  assumes Df_Cons: "a i d. a  closed_segment X (X + H)  i < n 
      ((λa. Df a i H H) has_derivative (Df a (Suc i) H)) (at a within G)"
  assumes cs: "closed_segment X (X + H)  G"
  defines "i  λx.
      ((1 - x) ^ (n - 1) / fact (n - 1)) *R Df (X + x *R H) n H H"
  shows multivariate_Taylor_has_integral:
    "(i has_integral f (X + H) - (i<n. (1 / fact i) *R Df X i H H)) {0..1}"
  and multivariate_Taylor:
    "f (X + H) = (i<n. (1 / fact i) *R Df X i H H) + integral {0..1} i"
  and multivariate_Taylor_integrable:
    "i integrable_on {0..1}"
proof goal_cases
  case 1
  let ?G = "closed_segment X (X + H)"
  define line where "line t = X + t *R H" for t
  have segment_eq: "closed_segment X (X + H) = line ` {0 .. 1}"
    by (auto simp: line_def closed_segment_def algebra_simps)
  have line_deriv: "x. (line has_derivative (λt. t *R H)) (at x)"
    by (auto intro!: derivative_eq_intros simp: line_def [abs_def])
  define g where "g = f o line"
  define Dg where "Dg n t = Df (line t) n H H" for n :: nat and t :: real
  note n > 0
  moreover
  have Dg0: "Dg 0 = g" by (auto simp add: Dg_def Df_Nil g_def)
  moreover
  have DgSuc: "(Dg m has_vector_derivative Dg (Suc m) t) (at t within {0..1})"
    if "m < n" "0  t" "t  1" for m::nat and t::real
  proof -
    from that have [intro]: "line t  ?G" using assms
      by (auto simp: segment_eq)
    note [derivative_intros] = has_derivative_in_compose[OF _ has_derivative_subset[OF Df_Cons]]
    interpret Df: linear "(λd. Df (line t) (Suc m) H d)"
      by (auto intro!: has_derivative_linear derivative_intros m < n)
    note [derivative_intros] =
      has_derivative_compose[OF _ line_deriv]
    show ?thesis
      using Df.scaleR m < n
      by (auto simp: Dg_def [abs_def] has_vector_derivative_def g_def segment_eq
         intro!: derivative_eq_intros subsetD[OF cs])
  qed
  ultimately
  have g_Taylor: "(i has_integral g 1 - (i<n. ((1 - 0) ^ i / fact i) *R Dg i 0)) {0 .. 1}"
    unfolding i_def Dg_def [abs_def] line_def
    by (rule Taylor_has_integral) auto
  then show c: ?case using n > 0 by (auto simp: g_def line_def Dg_def)
  case 2 show ?case using c
    by (simp add: integral_unique add.commute)
  case 3 show ?case using c by force
qed


subsection ‹Symmetric second derivative›

lemma symmetric_second_derivative_aux:
  assumes first_fderiv[derivative_intros]:
    "a. a  G  (f has_derivative (f' a)) (at a within G)"
  assumes second_fderiv[derivative_intros]:
    "i. ((λx. f' x i) has_derivative (λj. f'' j i)) (at a within G)"
  assumes "i  j" "i  0" "j  0"
  assumes "a  G"
  assumes "s t. s  {0..1}  t  {0..1}  a + s *R i + t *R j  G"
  shows "f'' j i = f'' i j"
proof -
  let ?F = "at_right (0::real)"
  define B where "B i j = {a + s *R i + t *R j |s t. s  {0..1}  t  {0..1}}" for i j
  have "B i j  G" using assms by (auto simp: B_def)
  {
    fix e::real and i j::'a
    assume "e > 0"
    assume "i  j" "i  0" "j  0"
    assume "B i j  G"
    let ?ij' = "λs t. λu. a + (s * u) *R i + (t * u) *R j"
    let ?ij = "λt. λu. a + (t * u) *R i + u *R j"
    let ?i = "λt. λu. a + (t * u) *R i"
    let ?g = "λu t. f (?ij t u) - f (?i t u)"
    have filter_ij'I: "P. P a  eventually P (at a within G) 
      eventually (λx. s{0..1}. t{0..1}. P (?ij' s t x)) ?F"
    proof -
      fix P
      assume "P a"
      assume "eventually P (at a within G)"
      hence "eventually P (at a within B i j)" by (rule filter_leD[OF at_le[OF B i j  G]])
      then obtain d where d: "d > 0" and "x d2. x  B i j  x  a  dist x a < d  P x"
        by (auto simp: eventually_at)
      with P a have P: "x d2. x  B i j  dist x a < d  P x" by (case_tac "x = a") auto
      let ?d = "min (min (d/norm i) (d/norm j) / 2) 1"
      show "eventually (λx. s{0..1}. t{0..1}. P (?ij' s t x)) (at_right 0)"
        unfolding eventually_at
      proof (rule exI[where x="?d"], safe)
        show "0 < ?d" using 0 < d i  0 j  0 by simp
        fix x s t :: real assume *: "s  {0..1}" "t  {0..1}" "0 < x" "dist x 0 < ?d"
        show "P (?ij' s t x)"
        proof (rule P)
          have "x y::real. x  {0..1}  y  {0..1}  x * y  {0..1}"
            by (auto intro!: order_trans[OF mult_left_le_one_le])
          hence "s * x  {0..1}" "t * x  {0..1}" using * by (auto simp: dist_norm)
          thus "?ij' s t x  B i j" by (auto simp: B_def)
          have "norm (s *R x *R i + t *R x *R j)  norm (s *R x *R i) + norm (t *R x *R j)"
            by (rule norm_triangle_ineq)
          also have " < d / 2 + d / 2" using * i  0 j  0
            by (intro add_strict_mono) (auto simp: ac_simps dist_norm
              pos_less_divide_eq le_less_trans[OF mult_left_le_one_le])
          finally show "dist (?ij' s t x) a < d" by (simp add: dist_norm)
        qed
      qed
    qed
    have filter_ijI: "eventually (λx. t{0..1}. P (?ij t x)) ?F"
      if "P a" "eventually P (at a within G)" for P
      using filter_ij'I[OF that]
        by eventually_elim (force dest: bspec[where x=1])
    have filter_iI: "eventually (λx. t{0..1}. P (?i t x)) ?F"
      if "P a" "eventually P (at a within G)" for P
      using filter_ij'I[OF that] by eventually_elim force
    {
      from second_fderiv[of i, simplified has_derivative_iff_norm, THEN conjunct2,
        THEN tendstoD, OF 0 < e]
      have "eventually (λx. norm (f' x i - f' a i - f'' (x - a) i) / norm (x - a)  e)
          (at a within G)"
        by eventually_elim (simp add: dist_norm)
      from filter_ijI[OF _ this] filter_iI[OF _ this] 0 < e
      have
        "eventually (λij. t{0..1}. norm (f' (?ij t ij) i - f' a i - f'' (?ij t ij - a) i) /
          norm (?ij t ij - a)  e) ?F"
        "eventually (λij. t{0..1}. norm (f' (?i t ij) i - f' a i - f'' (?i t ij - a) i) /
          norm (?i t ij - a)  e) ?F"
        by auto
      moreover
      have "eventually (λx. x  G) (at a within G)" unfolding eventually_at_filter by simp
      hence eventually_in_ij: "eventually (λx. t{0..1}. ?ij t x  G) ?F" and
        eventually_in_i: "eventually (λx. t{0..1}. ?i t x  G) ?F"
        using a  G by (auto dest: filter_ijI filter_iI)
      ultimately
      have "eventually (λu. norm (?g u 1 - ?g u 0 - (u * u) *R f'' j i) 
          u * u * e * (2 * norm i + 3 * norm j)) ?F"
      proof eventually_elim
        case (elim u)
        hence ijsub: "(λt. ?ij t u) ` {0..1}  G" and isub: "(λt. ?i t u) ` {0..1}  G" by auto
        note has_derivative_subset[OF _ ijsub, derivative_intros]
        note has_derivative_subset[OF _ isub, derivative_intros]
        let ?g' = "λt. (λua. u *R ua *R (f' (?ij t u) i - (f' (?i t u) i)))"
        have g': "((?g u) has_derivative ?g' t) (at t within {0..1})" if "t  {0..1}" for t::real
        proof -
          from elim that have linear_f': "c x. f' (?ij t u) (c *R x) = c *R f' (?ij t u) x"
              "c x. f' (?i t u) (c *R x) = c *R f' (?i t u) x"
            using linear_cmul[OF has_derivative_linear, OF first_fderiv] by auto
          show ?thesis
            using elim t  {0..1}
            by (auto intro!: derivative_eq_intros has_derivative_in_compose[of  "λt. ?ij t u" _ _ _ f]
                has_derivative_in_compose[of  "λt. ?i t u" _ _ _ f]
              simp: linear_f' scaleR_diff_right mult.commute)
        qed
        from elim(1) i  0 j  0 0 < e have f'ij: "t. t  {0..1} 
            norm (f' (a + (t * u) *R i + u *R j) i - f' a i - f'' ((t * u) *R i + u *R j) i) 
            e * norm ((t * u) *R i + u *R j)"
          using  linear_0[OF has_derivative_linear, OF second_fderiv]
          by (case_tac "u *R j + (t * u) *R i = 0") (auto simp: field_simps
            simp del: pos_divide_le_eq simp add: pos_divide_le_eq[symmetric])
        from elim(2) have f'i: "t. t  {0..1}  norm (f' (a + (t * u) *R i) i - f' a i -
          f'' ((t * u) *R i) i)  e * abs (t * u) * norm i"
          using i  0 j  0 linear_0[OF has_derivative_linear, OF second_fderiv]
          by (case_tac "t * u = 0") (auto simp: field_simps simp del: pos_divide_le_eq
            simp add: pos_divide_le_eq[symmetric])
        have "norm (?g u 1 - ?g u 0 - (u * u) *R f'' j i) =
          norm ((?g u 1 - ?g u 0 - u *R (f' (a + u *R j) i - (f' a i)))
            + u *R (f' (a + u *R j) i - f' a i - u *R f'' j i))"
            (is "_ = norm (?g10 + ?f'i)")
          by (simp add: algebra_simps linear_cmul[OF has_derivative_linear, OF second_fderiv]
            linear_add[OF has_derivative_linear, OF second_fderiv])
        also have "  norm ?g10 + norm ?f'i"
          by (blast intro: order_trans add_mono norm_triangle_le)
        also
        have "0  {0..1::real}" by simp
        have "t  {0..1}. onorm ((λua. (u * ua) *R (f' (?ij t u) i - f' (?i t u) i)) -
              (λua. (u * ua) *R (f' (a + u *R j) i - f' a i)))
             2 * u * u * e * (norm i + norm j)" (is "t  _. onorm (?d t)  _")
        proof
          fix t::real assume "t  {0..1}"
          show "onorm (?d t)  2 * u * u * e * (norm i + norm j)"
          proof (rule onorm_le)
            fix x
            have "norm (?d t x) =
                norm ((u * x) *R (f' (?ij t u) i - f' (?i t u) i - f' (a + u *R j) i + f' a i))"
              by (simp add: algebra_simps)
            also have " =
                abs (u * x) * norm (f' (?ij t u) i - f' (?i t u) i - f' (a + u *R j) i + f' a i)"
              by simp
            also have " = abs (u * x) * norm (
                 f' (?ij t u) i - f' a i - f'' ((t * u) *R i + u *R j) i
               - (f' (?i t u) i - f' a i - f'' ((t * u) *R i) i)
               - (f' (a + u *R j) i - f' a i - f'' (u *R j) i))"
               (is "_ = _ * norm (?dij - ?di - ?dj)")
              using a  G
              by (simp add: algebra_simps
                linear_add[OF has_derivative_linear[OF second_fderiv]])
            also have "  abs (u * x) * (norm ?dij + norm ?di + norm ?dj)"
              by (rule mult_left_mono[OF _ abs_ge_zero]) norm
            also have "  abs (u * x) *
              (e * norm ((t * u) *R i + u *R j) + e * abs (t * u) * norm i + e * (¦u¦ * norm j))"
              using f'ij f'i f'ij[OF 0  {0..1}] t  {0..1}
              by (auto intro!: add_mono mult_left_mono)
            also have " = abs u * abs x * abs u *
              (e * norm (t *R i + j) + e * norm (t *R i) + e * (norm j))"
              by (simp add: algebra_simps norm_scaleR[symmetric] abs_mult del: norm_scaleR)
            also have " =
                u * u * abs x * (e * norm (t *R i + j) + e * norm (t *R i) + e * (norm j))"
              by (simp add: ac_simps)
            also have " = u * u * e * abs x * (norm (t *R i + j) + norm (t *R i) + norm j)"
              by (simp add: algebra_simps)
            also have "  u * u * e * abs x * ((norm (1 *R i) + norm j) + norm (1 *R i) + norm j)"
              using t  {0..1} 0 < e
              by (intro mult_left_mono add_mono) (auto intro!: norm_triangle_le add_right_mono
                mult_left_le_one_le zero_le_square)
            finally show "norm (?d t x)  2 * u * u * e * (norm i + norm j) * norm x"
              by (simp add: ac_simps)
          qed
        qed
        with differentiable_bound_linearization[where f="?g u" and f'="?g'", of 0 1 _ 0, OF _ g']
        have "norm ?g10  2 * u * u * e * (norm i + norm j)" by simp
        also have "norm ?f'i  abs u *
          norm ((f' (a + (u) *R j) i - f' a i - f'' (u *R j) i))"
          using linear_cmul[OF has_derivative_linear, OF second_fderiv]
          by simp
        also have "  abs u * (e * norm ((u) *R j))"
          using f'ij[OF 0  {0..1}] by (auto intro: mult_left_mono)
        also have " = u * u * e * norm j" by (simp add: algebra_simps abs_mult)
        finally show ?case by (simp add: algebra_simps)
      qed
    }
  } note wlog = this
  have e': "norm (f'' j i - f'' i j)  e * (5 * norm j + 5 * norm i)" if "0 < e" for e t::real
  proof -
    have "B i j = B j i" using i  j by (force simp: B_def)+
    with assms B i j  G have "j  i" "B j i  G" by (auto simp:)
    from wlog[OF 0 < e i  j i  0 j  0 B i j  G]
         wlog[OF 0 < e j  i j  0 i  0 B j i  G]
    have "eventually (λu. norm ((u * u) *R f'' j i - (u * u) *R f'' i j)
          u * u * e * (5 * norm j + 5 * norm i)) ?F"
    proof eventually_elim
      case (elim u)
      have "norm ((u * u) *R f'' j i - (u * u) *R f'' i j) =
        norm (f (a + u *R j + u *R i) - f (a + u *R j) -
         (f (a + u *R i) - f a) - (u * u) *R f'' i j
         - (f (a + u *R i + u *R j) - f (a + u *R i) -
         (f (a + u *R j) - f a) -
         (u * u) *R f'' j i))" by (simp add: field_simps)
      also have "  u * u * e * (2 * norm j + 3 * norm i) + u * u * e * (3 * norm j + 2 * norm i)"
        using elim by (intro order_trans[OF norm_triangle_ineq4]) (auto simp: ac_simps intro: add_mono)
      finally show ?case by (simp add: algebra_simps)
    qed
    hence "eventually (λu. norm ((u * u) *R (f'' j i - f'' i j)) 
        u * u * e * (5 * norm j + 5 * norm i)) ?F"
      by (simp add: algebra_simps)
    hence "eventually (λu. (u * u) * norm ((f'' j i - f'' i j)) 
        (u * u) * (e * (5 * norm j + 5 * norm i))) ?F"
      by (simp add: ac_simps)
    hence "eventually (λu. norm ((f'' j i - f'' i j))  e * (5 * norm j + 5 * norm i)) ?F"
      unfolding mult_le_cancel_left eventually_at_filter
      by eventually_elim auto
    then show ?thesis
      by (auto simp add:eventually_at dist_norm dest!: bspec[where x="d/2" for d])
  qed
  have e: "norm (f'' j i - f'' i j) < e" if "0 < e" for e::real
  proof -
    let ?e = "e/2/(5 * norm j + 5 * norm i)"
    have "?e > 0" using 0 < e i  0 j  0 by (auto intro!: divide_pos_pos add_pos_pos)
    from e'[OF this] have "norm (f'' j i - f'' i j)  ?e * (5 * norm j + 5 * norm i)" .
    also have " = e / 2" using i  0 j  0 by (auto simp: ac_simps add_nonneg_eq_0_iff)
    also have " < e" using 0 < e by simp
    finally show ?thesis .
  qed
  have "norm (f'' j i - f'' i j) = 0"
  proof (rule ccontr)
    assume "norm (f'' j i - f'' i j)  0"
    hence "norm (f'' j i - f'' i j) > 0" by simp
    from e[OF this] show False by simp
  qed
  thus ?thesis by simp
qed

locale second_derivative_within =
  fixes f f' f'' a G
  assumes first_fderiv[derivative_intros]:
    "a. a  G  (f has_derivative blinfun_apply (f' a)) (at a within G)"
  assumes in_G: "a  G"
  assumes second_fderiv[derivative_intros]:
    "(f' has_derivative blinfun_apply f'') (at a within G)"
begin

lemma symmetric_second_derivative_within:
  assumes "a  G"
  assumes "s t. s  {0..1}  t  {0..1}  a + s *R i + t *R j  G"
  shows "f'' i j = f'' j i"
  apply (cases "i = j  i = 0  j = 0")
    apply (force simp add: blinfun.zero_right blinfun.zero_left)
  using first_fderiv _ _ _ _ assms
  by (rule symmetric_second_derivative_aux[symmetric])
    (auto intro!: derivative_eq_intros simp: blinfun.bilinear_simps assms)

end

locale second_derivative =
  fixes f::"'a::real_normed_vector  'b::banach"
    and f' :: "'a  'a L 'b"
    and f'' :: "'a L 'a L 'b"
    and a :: 'a
    and G :: "'a set"
  assumes first_fderiv[derivative_intros]:
    "a. a  G  (f has_derivative f' a) (at a)"
  assumes in_G: "a  interior G"
  assumes second_fderiv[derivative_intros]:
    "(f' has_derivative f'') (at a)"
begin

lemma symmetric_second_derivative:
  assumes "a  interior G"
  shows "f'' i j = f'' j i"
proof -
  from assms have "a  G"
    using interior_subset by blast
  interpret second_derivative_within
    by unfold_locales
      (auto intro!: derivative_intros intro: has_derivative_at_withinI a  G)
  from assms open_interior[of G] interior_subset[of G]
  obtain e where e: "e > 0" "y. dist y a < e  y  G"
    by (force simp: open_dist)
  define e' where "e' = e / 3"
  define i' j' where "i' = e' *R i /R norm i" and "j' = e' *R j /R norm j"
  hence "norm i'  e'" "norm j'  e'"
    by (auto simp: field_simps e'_def 0 < e less_imp_le)
  hence "¦s¦  1  ¦t¦  1  norm (s *R i' + t *R j')  e' + e'" for s t
    by (intro norm_triangle_le[OF add_mono])
      (auto intro!: order_trans[OF mult_left_le_one_le])
  also have " < e" by (simp add: e'_def 0 < e)
  finally
  have "f'' $ i' $ j' = f'' $ j' $ i'"
    by (intro symmetric_second_derivative_within a  G e)
      (auto simp add: dist_norm)
  thus ?thesis
    using e(1)
    by (auto simp: i'_def j'_def e'_def
      blinfun.zero_right blinfun.zero_left
      blinfun.scaleR_left blinfun.scaleR_right algebra_simps)
qed

end

lemma
  uniform_explicit_remainder_Taylor_1:
  fixes f::"'a::{banach,heine_borel,perfect_space}  'b::banach"
  assumes f'[derivative_intros]: "x. x  G  (f has_derivative blinfun_apply (f' x)) (at x)"
  assumes f'_cont: "x. x  G  isCont f' x"
  assumes "open G"
  assumes "J  {}" "compact J" "J  G"
  assumes "e > 0"
  obtains d R
  where "d > 0"
    "x z. f z = f x + f' x (z - x) + R x z"
    "x y. x  J  y  J  dist x y < d  norm (R x y)  e * dist x y"
    "continuous_on (G × G) (λ(a, b). R a b)"
proof -
  from assms have "continuous_on G f'" by (auto intro!: continuous_at_imp_continuous_on)
  note [continuous_intros] = continuous_on_compose2[OF this]
  define R where "R x z = f z - f x - f' x (z - x)" for x z
  from compact_in_open_separated[OF J  {} ‹compact J ‹open G J  G]
  obtain η where η: "0 < η" "{x. infdist x J  η}  G" (is "?J'  _")
    by auto
  hence infdist_in_G: "infdist x J  η  x  G" for x
    by auto
  have dist_in_G: "y. dist x y < η  y  G" if "x  J" for x
    by (auto intro!: infdist_in_G infdist_le2 that simp: dist_commute)

  have "compact ?J'" by (rule compact_infdist_le; fact)
  let ?seg = ?J'
  from ‹continuous_on G f'
  have ucont: "uniformly_continuous_on ?seg f'"
    using ?seg  G
    by (auto intro!: compact_uniformly_continuous ‹compact ?seg intro: continuous_on_subset)

  define e' where "e' = e / 2"
  have "e' > 0" using e > 0 by (simp add: e'_def)
  from ucont[unfolded uniformly_continuous_on_def, rule_format, OF 0 < e']
  obtain du where du:
    "du > 0"
    "x y. x  ?seg  y  ?seg  dist x y < du  norm (f' x - f' y) < e'"
    by (auto simp: dist_norm)
  have "min η du > 0" using du > 0 η > 0 by simp
  moreover
  have "f z = f x + f' x (z - x) + R x z" for x z
    by (auto simp: R_def)
  moreover
  {
    fix x z::'a
    assume "x  J" "z  J"
    hence "x  G" "z  G" using assms by auto

    assume "dist x z < min η du"
    hence d_eta: "dist x z < η" and d_du: "dist x z < du"
      by (auto simp add: min_def split: if_split_asm)

    from ‹dist x z < η have line_in:
      "xa. 0  xa  xa  1  x + xa *R (z - x)  G"
      "(λxa. x + xa *R (z - x)) ` {0..1}  G"
      by (auto intro!: dist_in_G x  J le_less_trans[OF mult_left_le_one_le]
        simp: dist_norm norm_minus_commute)

    have "R x z = f z - f x - f' x (z - x)"
      by (simp add: R_def)
    also have "f z - f x = f (x + (z - x)) - f x" by simp
    also have "f (x + (z - x)) - f x = integral {0..1} (λt. (f' (x + t *R (z - x))) (z - x))"
      using ‹dist x z < η
      by (intro mvt_integral[of "ball x η" f f' x "z - x"])
        (auto simp: dist_norm norm_minus_commute at_within_ball 0 < η mem_ball
          intro!: le_less_trans[OF mult_left_le_one_le] derivative_eq_intros dist_in_G x  J)
    also have
      "(integral {0..1} (λt. (f' (x + t *R (z - x))) (z - x)) - (f' x) (z - x)) =
        integral {0..1} (λt. f' (x + t *R (z - x)) - f' x) (z - x)"
      by (simp add: Henstock_Kurzweil_Integration.integral_diff integral_linear[where h="λy. blinfun_apply y (z - x)", simplified o_def]
        integrable_continuous_real continuous_intros line_in
        blinfun.bilinear_simps[symmetric])
    finally have "R x z = integral {0..1} (λt. f' (x + t *R (z - x)) - f' x) (z - x)"
      .
    also have "norm   norm (integral {0..1} (λt. f' (x + t *R (z - x)) - f' x)) * norm (z - x)"
      by (auto intro!: order_trans[OF norm_blinfun])
    also have "  e' * (1 - 0) * norm (z - x)"
      using d_eta d_du 0 < η
      by (intro mult_right_mono integral_bound)
        (auto simp: dist_norm norm_minus_commute
          intro!: line_in du[THEN less_imp_le] infdist_le2[OF x  J] line_in continuous_intros
            order_trans[OF mult_left_le_one_le] le_less_trans[OF mult_left_le_one_le])
    also have "  e * dist x z" using 0 < e by (simp add: e'_def norm_minus_commute dist_norm)
    finally have "norm (R x z)  e * dist x z" .
  }
  moreover
  {
    from f' have f_cont: "continuous_on G f"
      by (rule has_derivative_continuous_on[OF has_derivative_at_withinI])
    note [continuous_intros] = continuous_on_compose2[OF this]
    from f'_cont have f'_cont: "continuous_on G f'"
      by (auto intro!: continuous_at_imp_continuous_on)

    note continuous_on_diff2=continuous_on_diff[OF continuous_on_compose[OF continuous_on_snd] continuous_on_compose[OF continuous_on_fst], where s="G × G", simplified]
    have "continuous_on (G × G) (λ(a, b). f b - f a)"
      by (auto intro!: continuous_intros simp: split_beta)
    moreover have "continuous_on (G × G) (λ(a, b). f' a (b - a))"
      by (auto intro!: continuous_intros simp: split_beta')
    ultimately have "continuous_on (G × G) (λ(a, b). R a b)"
      by (rule iffD1[OF continuous_on_cong[OF refl] continuous_on_diff, rotated], auto simp: R_def)
  }
  ultimately
  show thesis ..
qed


text ‹TODO: rename, duplication?›

locale second_derivative_within' =
  fixes f f' f'' a G
  assumes first_fderiv[derivative_intros]:
    "a. a  G  (f has_derivative f' a) (at a within G)"
  assumes in_G: "a  G"
  assumes second_fderiv[derivative_intros]:
    "i. ((λx. f' x i) has_derivative f'' i) (at a within G)"
begin

lemma symmetric_second_derivative_within:
  assumes "a  G"  "open G"
  assumes "s t. s  {0..1}  t  {0..1}  a + s *R i + t *R j  G"
  shows "f'' i j = f'' j i"
proof (cases "i = j  i = 0  j = 0")
  case True
  interpret bounded_linear "f'' k" for k
    by (rule has_derivative_bounded_linear) (rule second_fderiv)
  have z1: "f'' j 0 = 0" "f'' i 0 = 0" by (simp_all add: zero)
  have f'z: "f' x 0 = 0" if "x  G" for x
  proof -
    interpret bounded_linear "f' x"
      by (rule has_derivative_bounded_linear) (rule first_fderiv that)+
    show ?thesis by (simp add: zero)
  qed
  note aw = at_within_open[OF a  G ‹open G]
  have "((λx. f' x 0) has_derivative (λ_. 0)) (at a within G)"
    apply (rule has_derivative_transform_within)
       apply (rule has_derivative_const[where c=0])
      apply (rule zero_less_one)
     apply fact
    by (simp add: f'z)
  from has_derivative_unique[OF second_fderiv[unfolded aw] this[unfolded aw]]
  have "f'' 0 = (λ_. 0)" .
  with True z1 show ?thesis
    by (auto)
next
  case False
  show ?thesis
    using first_fderiv _ _ _ _ assms(1,3-)
    by (rule symmetric_second_derivative_aux[])
       (use False in auto intro!: derivative_eq_intros simp: blinfun.bilinear_simps assms›)
qed

end

locale second_derivative_on_open =
  fixes f::"'a::real_normed_vector  'b::banach"
    and f' :: "'a  'a  'b"
    and f'' :: "'a  'a  'b"
    and a :: 'a
    and G :: "'a set"
  assumes first_fderiv[derivative_intros]:
    "a. a  G  (f has_derivative f' a) (at a)"
  assumes in_G: "a  G" and open_G: "open G"
  assumes second_fderiv[derivative_intros]:
    "((λx. f' x i) has_derivative f'' i) (at a)"
begin

lemma symmetric_second_derivative:
  assumes "a  G"
  shows "f'' i j = f'' j i"
proof -
  interpret second_derivative_within'
    by unfold_locales
      (auto intro!: derivative_intros intro: has_derivative_at_withinI a  G)
  from a  G open_G
  obtain e where e: "e > 0" "y. dist y a < e  y  G"
    by (force simp: open_dist)
  define e' where "e' = e / 3"
  define i' j' where "i' = e' *R i /R norm i" and "j' = e' *R j /R norm j"
  hence "norm i'  e'" "norm j'  e'"
    by (auto simp: field_simps e'_def 0 < e less_imp_le)
  hence "¦s¦  1  ¦t¦  1  norm (s *R i' + t *R j')  e' + e'" for s t
    by (intro norm_triangle_le[OF add_mono])
      (auto intro!: order_trans[OF mult_left_le_one_le])
  also have " < e" by (simp add: e'_def 0 < e)
  finally
  have "f'' i' j' = f'' j' i'"
    by (intro symmetric_second_derivative_within a  G e)
      (auto simp add: dist_norm open_G)
  moreover
  interpret f'': bounded_linear "f'' k" for k
    by (rule has_derivative_bounded_linear) (rule second_fderiv)
  note aw = at_within_open[OF a  G ‹open G]
  have z1: "f'' j 0 = 0" "f'' i 0 = 0" by (simp_all add: f''.zero)
  have f'z: "f' x 0 = 0" if "x  G" for x
  proof -
    interpret bounded_linear "f' x"
      by (rule has_derivative_bounded_linear) (rule first_fderiv that)+
    show ?thesis by (simp add: zero)
  qed
  have "((λx. f' x 0) has_derivative (λ_. 0)) (at a within G)"
    apply (rule has_derivative_transform_within)
       apply (rule has_derivative_const[where c=0])
      apply (rule zero_less_one)
     apply fact
    by (simp add: f'z)
  from has_derivative_unique[OF second_fderiv[unfolded aw] this[unfolded aw]]
  have z2: "f'' 0 = (λ_. 0)" .
  have "((λa. f' a (r *R x)) has_derivative f'' (r *R x)) (at a within G)"
    "((λa. f' a (r *R x)) has_derivative (λy. r *R f'' x y)) (at a within G)"
    for r x
    subgoal by (rule second_fderiv)
    subgoal
    proof -
      have "((λa. r *R f' a (x)) has_derivative (λy. r *R f'' x y)) (at a within G)"
        by (auto intro!: derivative_intros)
      then show ?thesis
        apply (rule has_derivative_transform[rotated 2])
         apply (rule in_G)
        subgoal premises prems for a'
        proof -
          interpret bounded_linear "f' a'"
            apply (rule has_derivative_bounded_linear)
            by (rule first_fderiv[OF prems])
          show ?thesis
            by (simp add: scaleR)
        qed
        done
    qed
    done
  then have "((λa. f' a (r *R x)) has_derivative f'' (r *R x)) (at a)"
    "((λa. f' a (r *R x)) has_derivative (λy. r *R f'' x y)) (at a)" for r x
    unfolding aw by auto
  then have f'z: "f'' (r *R x) = (λy. r *R f'' x y)" for r x
    by (rule has_derivative_unique[where f="(λa. f' a (r *R x))"])
  ultimately show ?thesis
    using e(1)
    by (auto simp: i'_def j'_def e'_def f''.scaleR z1 z2
      blinfun.zero_right blinfun.zero_left
      blinfun.scaleR_left blinfun.scaleR_right algebra_simps)
qed

end

no_notation
  blinfun_apply (infixl "$" 999)
notation vec_nth (infixl "$" 90)

end

Theory Flow

section ‹Flow›
theory Flow
imports
  Picard_Lindeloef_Qualitative
  "HOL-Library.Diagonal_Subsequence"
  "../Library/Bounded_Linear_Operator"
  "../Library/Multivariate_Taylor"
  "../Library/Interval_Integral_HK"
begin

text ‹TODO: extend theorems for dependence on initial time›

subsection ‹simp rules for integrability (TODO: move)›

lemma blinfun_ext: "x = y  (i. blinfun_apply x i = blinfun_apply y i)"
  by transfer auto

notation id_blinfun ("1L")

lemma blinfun_inverse_left:
  fixes f::"'a::euclidean_space L 'a" and f'
  shows "f oL f' = 1L  f' oL f = 1L"
  by transfer
    (auto dest!: bounded_linear.linear simp: id_def[symmetric]
      linear_inverse_left)

lemma onorm_zero_blinfun[simp]: "onorm (blinfun_apply 0) = 0"
  by transfer (simp add: onorm_zero)

lemma blinfun_compose_1_left[simp]: "x oL 1L = x"
  and blinfun_compose_1_right[simp]: "1L oL y = y"
  by (auto intro!: blinfun_eqI)


named_theorems integrable_on_simps

lemma integrable_on_refl_ivl[intro, simp]: "g integrable_on {b .. (b::'b::ordered_euclidean_space)}"
  and integrable_on_refl_closed_segment[intro, simp]: "h integrable_on closed_segment a a"
  using integrable_on_refl by auto

lemma integrable_const_ivl_closed_segment[intro, simp]: "(λx. c) integrable_on closed_segment a (b::real)"
  by (auto simp: closed_segment_eq_real_ivl)

lemma integrable_ident_ivl[intro, simp]: "(λx. x) integrable_on closed_segment a (b::real)"
  and integrable_ident_cbox[intro, simp]: "(λx. x) integrable_on cbox a (b::real)"
  by (auto simp: closed_segment_eq_real_ivl ident_integrable_on)

lemma content_closed_segment_real:
  fixes a b::real
  shows "content (closed_segment a b) = abs (b - a)"
  by (auto simp: closed_segment_eq_real_ivl)

lemma integral_const_closed_segment:
  fixes a b::real
  shows "integral (closed_segment a b) (λx. c) = abs (b - a) *R c"
  by (auto simp: closed_segment_eq_real_ivl content_closed_segment_real)

lemmas [integrable_on_simps] =
  integrable_on_empty ― ‹empty›
  integrable_on_refl integrable_on_refl_ivl integrable_on_refl_closed_segment ― ‹singleton›
  integrable_const integrable_const_ivl integrable_const_ivl_closed_segment ― ‹constant›
  ident_integrable_on integrable_ident_ivl integrable_ident_cbox ― ‹identity›

lemma integrable_cmul_real:
  fixes K::real
  shows "f integrable_on X  (λx. K * f x) integrable_on X "
  unfolding real_scaleR_def[symmetric]
  by (rule integrable_cmul)

lemmas [integrable_on_simps] =
  integrable_0
  integrable_neg
  integrable_cmul
  integrable_cmul_real
  integrable_on_cmult_iff
  integrable_on_cmult_left
  integrable_on_cmult_right
  integrable_on_cdivide
  integrable_on_cmult_iff
  integrable_on_cmult_left_iff
  integrable_on_cmult_right_iff
  integrable_on_cdivide_iff
  integrable_diff
  integrable_add
  integrable_sum

lemma dist_cancel_add1: "dist (t0 + et) t0 = norm et"
  by (simp add: dist_norm)

lemma double_nonneg_le:
  fixes a::real
  shows "a * 2  b  a  0  a  b"
  by arith


subsection ‹Nonautonomous IVP on maximal existence interval›

context ll_on_open_it
begin

context
fixes x0
assumes iv_defined: "t0  T" "x0  X"
begin

lemmas closed_segment_iv_subset_domain = closed_segment_subset_domainI[OF iv_defined(1)]

lemma
  local_unique_solutions:
  obtains t u L
  where
    "0 < t" "0 < u"
    "cball t0 t  existence_ivl t0 x0"
    "cball x0 (2 * u)  X"
    "t'. t'  cball t0 t  L-lipschitz_on (cball x0 (2 * u)) (f t')"
    "x. x  cball x0 u  (flow t0 x usolves_ode f from t0) (cball t0 t) (cball x u)"
    "x. x  cball x0 u  cball x u  X"
proof -
  from local_unique_solution[OF iv_defined] obtain et ex B L
    where "0 < et" "0 < ex" "cball t0 et  T" "cball x0 ex  X"
      "unique_on_cylinder t0 (cball t0 et) x0 ex f B L"
    by metis
  then interpret cyl: unique_on_cylinder t0 "cball t0 et" x0 ex "cball x0 ex" f B L
    by auto

  from cyl.solution_solves_ode order_refl ‹cball x0 ex  X
  have "(cyl.solution solves_ode f) (cball t0 et) X"
    by (rule solves_ode_on_subset)
  then have "cball t0 et  existence_ivl t0 x0"
    by (rule existence_ivl_maximal_interval) (insert ‹cball t0 et  T 0 < et, auto)

  have "cball t0 et = {t0 - et .. t0 + et}"
    using et > 0 by (auto simp: dist_real_def)
  then have cylbounds[simp]: "cyl.tmin = t0 - et" "cyl.tmax = t0 + et"
    unfolding cyl.tmin_def cyl.tmax_def
    using 0 < et
    by auto

  define et' where "et'  et / 2"
  define ex' where "ex'  ex / 2"

  have "et' > 0" "ex' > 0" using 0 < et 0 < ex by (auto simp: et'_def ex'_def)
  moreover
  from ‹cball t0 et  existence_ivl t0 x0 have "cball t0 et'  existence_ivl t0 x0"
    by (force simp: et'_def dest!: double_nonneg_le)
  moreover
  from this have "cball t0 et'  T" using existence_ivl_subset[of x0] by simp
  have  "cball x0 (2 * ex')  X" "t'. t'  cball t0 et'  L-lipschitz_on (cball x0 (2 * ex')) (f t')"
    using cyl.lipschitz 0 < et ‹cball x0 ex  X
    by (auto simp: ex'_def et'_def intro!:)
  moreover
  {
    fix x0'::'a
    assume x0': "x0'  cball x0 ex'"
    {
      fix b
      assume d: "dist x0' b  ex'"
      have "dist x0 b  dist x0 x0' + dist x0' b"
        by (rule dist_triangle)
      also have "  ex' + ex'"
        using x0' d by simp
      also have "  ex" by (simp add: ex'_def)
      finally have "dist x0 b  ex" .
    } note triangle = this
    have subs1: "cball t0 et'  cball t0 et"
      and subs2: "cball x0' ex'  cball x0 ex"
      and subs: "cball t0 et' × cball x0' ex'  cball t0 et × cball x0 ex"
      using 0 < ex 0 < et x0'
      by (auto simp: ex'_def et'_def triangle dest!: double_nonneg_le)

    have subset_X: "cball x0' ex'  X"
      using ‹cball x0 ex  X subs2 0 < ex' by force
    then have "x0'  X" using 0 < ex' by force
    have x0': "t0  T" "x0'  X" by fact+
    have half_intros: "a  ex'  a  ex" "a  et'  a  et"
      and halfdiv_intro: "a * 2  ex / B  a  ex' / B" for a
      using 0 < ex 0 < et
      by (auto simp: ex'_def et'_def)

    interpret cyl': solution_in_cylinder t0 "cball t0 et'" x0' ex' f "cball x0' ex'" B
      using 0 < et' 0 < ex' 0 < et cyl.norm_f cyl.continuous subs1 ‹cball t0 et  T
      apply unfold_locales
      apply (auto simp: split_beta' dist_cancel_add1 intro!: triangle
        continuous_intros cyl.norm_f order_trans[OF _ cyl.e_bounded] halfdiv_intro)
      by (simp add: ex'_def et'_def dist_commute)

    interpret cyl': unique_on_cylinder t0 "cball t0 et'" x0' ex' "cball x0' ex'" f B L
      using cyl.lipschitz[simplified] subs subs1
      by (unfold_locales)
         (auto simp: triangle intro!: half_intros lipschitz_on_subset[OF _ subs2])
    from cyl'.solution_usolves_ode
    have "(flow t0 x0' usolves_ode f from t0) (cball t0 et') (cball x0' ex')"
      apply (rule usolves_ode_solves_odeI)
      subgoal
        apply (rule cyl'.solves_ode_on_subset_domain[where Y=X])
        subgoal
          apply (rule solves_ode_on_subset[where S="existence_ivl t0 x0'" and Y=X])
          subgoal by (rule flow_solves_ode[OF x0'])
          subgoal
            using subs2 ‹cball x0 ex  X 0 < et' ‹cball t0 et'  T
            by (intro existence_ivl_maximal_interval[OF solves_ode_on_subset[OF cyl'.solution_solves_ode]])
              auto
          subgoal by force
          done
        subgoal by (force simp: x0'  X iv_defined)
        subgoal using 0 < et' by force
        subgoal by force
        subgoal by force
        done
      subgoal by (force simp: x0'  X iv_defined cyl'.solution_iv)
      done
    note this subset_X
  } ultimately show thesis ..
qed

lemma Picard_iterate_mem_existence_ivlI:
  assumes "t  T"
  assumes "compact C" "x0  C" "C  X"
  assumes "y s. s  {t0 -- t}  y t0 = x0  y  {t0--s}  C  continuous_on {t0--s} y 
      x0 + ivl_integral t0 s (λt. f t (y t))  C"
  shows "t  existence_ivl t0 x0" "s. s  {t0 -- t}  flow t0 x0 s  C"
proof -
  have "{t0 -- t}  T"
    by (intro closed_segment_subset_domain iv_defined assms)
  from lipschitz_on_compact[OF compact_segment {t0 -- t}  T ‹compact C C  X]
  obtain L where L: "s. s  {t0 -- t}  L-lipschitz_on C (f s)" by metis
  interpret uc: unique_on_closed t0 "{t0 -- t}" x0 f C L
    using assms closed_segment_iv_subset_domain
    by unfold_locales
      (auto intro!: L compact_imp_closed ‹compact C continuous_on_f continuous_intros
        simp: split_beta)
  have "{t0 -- t}  existence_ivl t0 x0"
    using assms closed_segment_iv_subset_domain
    by (intro maximal_existence_flow[OF solves_ode_on_subset[OF uc.solution_solves_ode]])
      (auto simp: )
  thus "t  existence_ivl t0 x0"
    using assms by auto
  show "flow t0 x0 s  C" if "s  {t0 -- t}" for s
  proof -
    have "flow t0 x0 s = uc.solution s" "uc.solution s  C"
      using solves_odeD[OF uc.solution_solves_ode] that assms
      by (auto simp: closed_segment_iv_subset_domain
        intro!:  maximal_existence_flowI(2)[where K="{t0 -- t}"])
    thus ?thesis by simp
  qed
qed

lemma flow_has_vderiv_on: "(flow t0 x0 has_vderiv_on (λt. f t (flow t0 x0 t))) (existence_ivl t0 x0)"
  by (rule solves_ode_vderivD[OF flow_solves_ode[OF iv_defined]])

lemmas flow_has_vderiv_on_compose[derivative_intros] =
  has_vderiv_on_compose2[OF flow_has_vderiv_on, THEN has_vderiv_on_eq_rhs]

end

lemma unique_on_intersection:
  assumes sols: "(x solves_ode f) U X" "(y solves_ode f) V X"
  assumes iv_mem: "t0  U" "t0  V" and subs: "U  T" "V  T"
  assumes ivls: "is_interval U" "is_interval V"
  assumes iv: "x t0 = y t0"
  assumes mem: "t  U" "t  V"
  shows "x t = y t"
proof -
  from
    maximal_existence_flow(2)[OF sols(1) refl          ivls(1) iv_mem(1) subs(1) mem(1)]
    maximal_existence_flow(2)[OF sols(2) iv[symmetric] ivls(2) iv_mem(2) subs(2) mem(2)]
  show ?thesis by simp
qed

lemma unique_solution:
  assumes sols: "(x solves_ode f) U X" "(y solves_ode f) U X"
  assumes iv_mem: "t0  U" and subs: "U  T"
  assumes ivls: "is_interval U"
  assumes iv: "x t0 = y t0"
  assumes mem: "t  U"
  shows "x t = y t"
  by (metis unique_on_intersection assms)

lemma
  assumes s: "s  existence_ivl t0 x0"
  assumes t: "t + s  existence_ivl s (flow t0 x0 s)"
  shows flow_trans: "flow t0 x0 (s + t) = flow s (flow t0 x0 s) (s + t)"
    and existence_ivl_trans: "s + t  existence_ivl t0 x0"
proof -
  note ll_on_open_it_axioms
  moreover
  from ll_on_open_it_axioms
  have iv_defined: "t0  T" "x0  X"
    and iv_defined': "s  T" "flow t0 x0 s  X"
    using ll_on_open_it.mem_existence_ivl_iv_defined s t
    by blast+

  have "{t0--s}  existence_ivl t0 x0"
    by (simp add: s segment_subset_existence_ivl iv_defined)

  have "s  existence_ivl s (flow t0 x0 s)"
    by (rule ll_on_open_it.existence_ivl_initial_time; fact)
  have "{s--t + s}  existence_ivl s (flow t0 x0 s)"
    by (rule ll_on_open_it.segment_subset_existence_ivl; fact)

  have unique: "flow t0 x0 u = flow s (flow t0 x0 s) u"
    if "u  {s--t + s}" "u  {t0--s}" for u
    using
      ll_on_open_it_axioms
      ll_on_open_it.flow_solves_ode[OF ll_on_open_it_axioms iv_defined]
      ll_on_open_it.flow_solves_ode[OF ll_on_open_it_axioms iv_defined']
      s
    apply (rule ll_on_open_it.unique_on_intersection)
    using s  existence_ivl s (flow t0 x0 s) existence_ivl_subset
      ‹flow t0 x0 s  X s  T iv_defined s t ll_on_open_it.in_existence_between_zeroI
      that ll_on_open_it_axioms ll_on_open_it.mem_existence_ivl_subset
    by (auto simp: is_interval_existence_ivl)

  let ?un = "{t0 -- s}  {s -- t + s}"
  let ?if = "λt. if t  {t0 -- s} then flow t0 x0 t else flow s (flow t0 x0 s) t"
  have "(?if solves_ode (λt. if t  {t0 -- s} then f t else f t)) ?un (X  X)"
    apply (rule connection_solves_ode)
    subgoal by (rule solves_ode_on_subset[OF flow_solves_ode[OF iv_defined] {t0--s}  _ order_refl])
    subgoal
      by (rule solves_ode_on_subset[OF ll_on_open_it.flow_solves_ode[OF ll_on_open_it_axioms iv_defined']
          {s--t + s}  _ order_refl])
    subgoal by simp
    subgoal by simp
    subgoal by (rule unique) auto
    subgoal by simp
    done
  then have ifsol: "(?if solves_ode f) ?un X"
    by simp
  moreover
  have "?un  existence_ivl t0 x0"
    using existence_ivl_subset[of x0]
      ll_on_open_it.existence_ivl_subset[OF ll_on_open_it_axioms, of s "flow t0 x0 s"]
      {t0 -- s}  _ {s--t + s}  _
    by (intro existence_ivl_maximal_interval[OF ifsol]) (auto intro!: is_real_interval_union)
  then show "s + t  existence_ivl t0 x0"
    by (auto simp: ac_simps)
  have "(flow t0 x0 solves_ode f) ?un X"
    using {t0--s}  _ {s -- t + s}  _
    by (intro solves_ode_on_subset[OF flow_solves_ode ?un  _ order_refl] iv_defined)
  moreover have "s  ?un"
    by simp
  ultimately have "?if (s + t) = flow t0 x0 (s + t)"
    apply (rule ll_on_open_it.unique_solution)
    using existence_ivl_subset[of x0]
      ll_on_open_it.existence_ivl_subset[OF ll_on_open_it_axioms, of s "flow t0 x0 s"]
      {t0 -- s}  _ {s--t + s}  _
    by (auto intro!: is_real_interval_union simp: ac_simps)
  with unique[of "s + t"]
  show "flow t0 x0 (s + t) = flow s (flow t0 x0 s) (s + t)"
    by (auto split: if_splits simp: ac_simps)
qed

lemma
  assumes t: "t  existence_ivl t0 x0"
  shows flows_reverse: "flow t (flow t0 x0 t) t0 = x0"
    and existence_ivl_reverse: "t0  existence_ivl t (flow t0 x0 t)"
proof -
  have iv_defined: "t0  T" "x0  X"
    using mem_existence_ivl_iv_defined t by blast+
  show "t0  existence_ivl t (flow t0 x0 t)"
    using assms
    by (metis (no_types, hide_lams) closed_segment_commute closed_segment_subset_interval
        ends_in_segment(2) general.csol(2-4)
        general.existence_ivl_maximal_segment general.is_interval_existence_ivl
        is_interval_closed_segment_1 iv_defined ll_on_open_it.equals_flowI
        local.existence_ivl_initial_time local.flow_initial_time local.ll_on_open_it_axioms)
  then have "flow t (flow t0 x0 t) (t + (t0 - t)) = flow t0 x0 (t + (t0 - t))"
    by (intro flow_trans[symmetric]) (auto simp: t iv_defined)
  then show "flow t (flow t0 x0 t) t0 = x0"
    by (simp add: iv_defined)
qed

lemma flow_has_derivative:
  assumes "t  existence_ivl t0 x0"
  shows "(flow t0 x0 has_derivative (λi. i *R f t (flow t0 x0 t))) (at t)"
proof -
  have "(flow t0 x0 has_derivative (λi. i *R f t (flow t0 x0 t))) (at t within existence_ivl t0 x0)"
    using flow_has_vderiv_on
    by (auto simp: has_vderiv_on_def has_vector_derivative_def assms mem_existence_ivl_iv_defined[OF assms])
  then show ?thesis
    by (simp add: at_within_open[OF assms open_existence_ivl])
qed


lemma flow_has_vector_derivative:
  assumes "t  existence_ivl t0 x0"
  shows "(flow t0 x0 has_vector_derivative f t (flow t0 x0 t)) (at t)"
  using flow_has_derivative[OF assms]
  by (simp add: has_vector_derivative_def)

lemma flow_has_vector_derivative_at_0:
  assumes"t  existence_ivl t0 x0"
  shows "((λh. flow t0 x0 (t + h)) has_vector_derivative f t (flow t0 x0 t)) (at 0)"
proof -
  from flow_has_vector_derivative[OF assms]
  have
    "((+) t has_vector_derivative 1) (at 0)"
    "(flow t0 x0 has_vector_derivative f t (flow t0 x0 t)) (at (t + 0))"
    by (auto intro!: derivative_eq_intros)
  from vector_diff_chain_at[OF this]
  show ?thesis by (simp add: o_def)
qed

lemma
  assumes "t  existence_ivl t0 x0"
  shows closed_segment_subset_existence_ivl: "closed_segment t0 t  existence_ivl t0 x0"
    and ivl_subset_existence_ivl: "{t0 .. t}  existence_ivl t0 x0"
    and ivl_subset_existence_ivl': "{t .. t0}  existence_ivl t0 x0"
  using assms in_existence_between_zeroI
  by (auto simp: closed_segment_eq_real_ivl)

lemma flow_fixed_point:
  assumes t: "t  existence_ivl t0 x0"
  shows "flow t0 x0 t = x0 + ivl_integral t0 t (λt. f t (flow t0 x0 t))"
proof -
  have "(flow t0 x0 has_vderiv_on (λs. f s (flow t0 x0 s))) {t0 -- t}"
    using closed_segment_subset_existence_ivl[OF t]
    by (auto intro!: has_vector_derivative_at_within flow_has_vector_derivative
      simp: has_vderiv_on_def)
  from fundamental_theorem_of_calculus_ivl_integral[OF this]
  have "((λt. f t (flow t0 x0 t)) has_ivl_integral flow t0 x0 t - x0) t0 t"
    by (simp add: mem_existence_ivl_iv_defined[OF assms])
  from this[THEN ivl_integral_unique]
  show ?thesis by (simp add: )
qed

lemma flow_continuous: "t  existence_ivl t0 x0  continuous (at t) (flow t0 x0)"
  by (metis has_derivative_continuous flow_has_derivative)

lemma flow_tendsto: "t  existence_ivl t0 x0  (ts  t) F 
    ((λs. flow t0 x0 (ts s))  flow t0 x0 t) F"
  by (rule isCont_tendsto_compose[OF flow_continuous])

lemma flow_continuous_on: "continuous_on (existence_ivl t0 x0) (flow t0 x0)"
  by (auto intro!: flow_continuous continuous_at_imp_continuous_on)

lemma flow_continuous_on_intro:
  "continuous_on s g 
  (xa. xa  s  g xa  existence_ivl t0 x0) 
  continuous_on s (λxa. flow t0 x0 (g xa))"
  by (auto intro!: continuous_on_compose2[OF flow_continuous_on])

lemma f_flow_continuous:
  assumes "t  existence_ivl t0 x0"
  shows "isCont (λt. f t (flow t0 x0 t)) t"
  by (rule continuous_on_interior)
    (insert existence_ivl_subset assms,
      auto intro!: flow_in_domain flow_continuous_on continuous_intros
        simp: interior_open open_existence_ivl)

lemma exponential_initial_condition:
  assumes y0: "t  existence_ivl t0 y0"
  assumes z0: "t  existence_ivl t0 z0"
  assumes "Y  X"
  assumes remain: "s. s  closed_segment t0 t  flow t0 y0 s  Y"
    "s. s  closed_segment t0 t  flow t0 z0 s  Y"
  assumes lipschitz: "s. s  closed_segment t0 t  K-lipschitz_on Y (f s)"
  shows "norm (flow t0 y0 t - flow t0 z0 t)  norm (y0 - z0) * exp ((K + 1) * abs (t - t0))"
proof cases
  assume "y0 = z0"
  thus ?thesis
    by simp
next
  assume ne: "y0  z0"
  define K' where "K'  K + 1"
  from lipschitz have "K'-lipschitz_on Y (f s)" if "s  {t0 -- t}" for s
    using that
    by (auto simp: lipschitz_on_def K'_def
      intro!: order_trans[OF _ mult_right_mono[of K "K + 1"]])

  from mem_existence_ivl_iv_defined[OF y0] mem_existence_ivl_iv_defined[OF z0]
  have "t0  T" and inX: "y0  X" "z0  X" by auto

  from remain[of t0] inX t0  T have "y0  Y" "z0  Y" by auto

  define v where "v  λt. norm (flow t0 y0 t - flow t0 z0 t)"
  {
    fix s
    assume s: "s  {t0 -- t}"
    with s
      closed_segment_subset_existence_ivl[OF y0]
      closed_segment_subset_existence_ivl[OF z0]
    have
      y0': "s  existence_ivl t0 y0" and
      z0': "s  existence_ivl t0 z0"
      by (auto simp: closed_segment_eq_real_ivl)
    have integrable:
      "(λt. f t (flow t0 y0 t)) integrable_on {t0--s}"
      "(λt. f t (flow t0 z0 t)) integrable_on {t0--s}"
      using closed_segment_subset_existence_ivl[OF y0']
        closed_segment_subset_existence_ivl[OF z0']
        y0  X z0  X t0  T
      by (auto intro!: continuous_at_imp_continuous_on f_flow_continuous
        integrable_continuous_closed_segment)
    hence int: "flow t0 y0 s - flow t0 z0 s =
        y0 - z0 + ivl_integral t0 s (λt. f t (flow t0 y0 t) - f t (flow t0 z0 t))"
      unfolding v_def
      using flow_fixed_point[OF y0'] flow_fixed_point[OF z0']
        s
      by (auto simp: algebra_simps ivl_integral_diff)
    have "v s  v t0 + K' *  integral {t0 -- s} (λt. v t)"
      using closed_segment_subset_existence_ivl[OF y0'] closed_segment_subset_existence_ivl[OF z0'] s
        using closed_segment_closed_segment_subset[OF _ _ s, of _ t0, simplified]
      by (subst integral_mult)
        (auto simp: integral_mult v_def int inX t0  T
          simp del: Henstock_Kurzweil_Integration.integral_mult_right
          intro!: norm_triangle_le ivl_integral_norm_bound_integral
            integrable_continuous_closed_segment continuous_intros
            continuous_at_imp_continuous_on flow_continuous f_flow_continuous
            lipschitz_on_normD[OF _  K'-lipschitz_on _ _] remain)
  } note le = this
  have cont: "continuous_on {t0 -- t} v"
    using closed_segment_subset_existence_ivl[OF y0] closed_segment_subset_existence_ivl[OF z0] inX
    by (auto simp: v_def t0  T
      intro!: continuous_at_imp_continuous_on continuous_intros flow_continuous)
  have nonneg: "t. v t  0"
    by (auto simp: v_def)
  from ne have pos: "v t0 > 0"
    by (auto simp: v_def t0  T inX)
  have lippos: "K' > 0"
  proof -
    have "0  dist (f t0 y0) (f t0 z0)" by simp
    also from lipschitz_onD[OF lipschitz y0  Y z0  Y, of t0]ne
    have "  K * dist y0 z0"
      by simp
    finally have "0  K"
      by (metis dist_le_zero_iff ne zero_le_mult_iff)
    thus ?thesis by (simp add: K'_def)
  qed
  from le cont nonneg pos 0 < K'
  have "v t  v t0 * exp (K' * abs (t - t0))"
    by (rule gronwall_general_segment) simp_all
  thus ?thesis
    by (simp add: v_def K'_def t0  T inX)
qed

lemma
  existence_ivl_cballs:
  assumes iv_defined: "t0  T" "x0  X"
  obtains t u L
  where
    "y. y  cball x0 u  cball t0 t  existence_ivl t0 y"
    "s y. y  cball x0 u  s  cball t0 t  flow t0 y s  cball y u"
    "L-lipschitz_on (cball t0 t×cball x0 u) (λ(t, x). flow t0 x t)"
    "y. y  cball x0 u  cball y u  X"
    "0 < t" "0 < u"
proof -
  note iv_defined
  from local_unique_solutions[OF this]
  obtain t u L where tu: "0 < t" "0 < u"
    and subsT: "cball t0 t  existence_ivl t0 x0"
    and subs': "cball x0 (2 * u)  X"
    and lipschitz: "s. s  cball t0 t  L-lipschitz_on (cball x0 (2*u)) (f s)"
    and usol: "y. y  cball x0 u  (flow t0 y usolves_ode f from t0) (cball t0 t) (cball y u)"
    and subs: "y. y  cball x0 u  cball y u  X"
    by metis
  {
    fix y assume y: "y  cball x0 u"
    from subs[OF y] 0 < u have "y  X" by auto
    note iv' = t0  T y  X
    from usol[OF y, THEN usolves_odeD(1)]
    have sol1: "(flow t0 y solves_ode f) (cball t0 t) (cball y u)" .
    from sol1 order_refl subs[OF y]
    have sol: "(flow t0 y solves_ode f) (cball t0 t) X"
      by (rule solves_ode_on_subset)
    note * = maximal_existence_flow[OF sol flow_initial_time
        is_interval_cball_1 _ order_trans[OF subsT existence_ivl_subset],
        unfolded centre_in_cball, OF iv' less_imp_le[OF 0 < t]]
    have eivl: "cball t0 t  existence_ivl t0 y"
      by (rule *)
    have "flow t0 y s  cball y u" if "s  cball t0 t" for s
      by (rule solves_odeD(2)[OF sol1 that])
    note eivl this
  } note * = this
  note *
  moreover
  have cont_on_f_flow:
    "x1 S. S  cball t0 t  x1  cball x0 u  continuous_on S (λt. f t (flow t0 x1 t))"
    using subs[of x0] u > 0 *(1) iv_defined
    by (auto intro!: continuous_at_imp_continuous_on f_flow_continuous)
  have "bounded ((λ(t, x). f t x) ` (cball t0 t × cball x0 (2 * u)))"
    using subs' subsT existence_ivl_subset[of x0]
    by (auto intro!: compact_imp_bounded compact_continuous_image compact_Times
      continuous_intros simp: split_beta')
  then obtain B where B: "s y. s  cball t0 t  y  cball x0 (2 * u)  norm (f s y)  B" "B > 0"
    by (auto simp: bounded_pos cball_def)
  have flow_in_cball: "flow t0 x1 s  cball x0 (2 * u)"
    if s: "s  cball t0 t" and x1: "x1  cball x0 u"
    for s::real and x1
  proof -
    from *(2)[OF x1 s] have "flow t0 x1 s  cball x1 u" .
    also have "  cball x0 (2 * u)"
      using x1
      by (auto intro!: dist_triangle_le[OF add_mono, of _ x1 u _ u, simplified]
        simp: dist_commute)
    finally show ?thesis .
  qed
  have "(B + exp ((L + 1) * ¦t¦))-lipschitz_on (cball t0 t×cball x0 u) (λ(t, x). flow t0 x t)"
  proof (rule lipschitz_onI, safe)
    fix t1 t2 :: real and x1 x2
    assume t1: "t1  cball t0 t" and t2: "t2  cball t0 t"
      and x1: "x1  cball x0 u" and x2: "x2  cball x0 u"
    have t1_ex: "t1  existence_ivl t0 x1"
      and t2_ex: "t2  existence_ivl t0 x1" "t2  existence_ivl t0 x2"
      and "x1  cball x0 (2*u)" "x2  cball x0 (2*u)"
      using *(1)[OF x1] *(1)[OF x2] t1 t2 x1 x2 tu by auto
    have "dist (flow t0 x1 t1) (flow t0 x2 t2) 
      dist (flow t0 x1 t1) (flow t0 x1 t2) + dist (flow t0 x1 t2) (flow t0 x2 t2)"
      by (rule dist_triangle)
    also have "dist (flow t0 x1 t2) (flow t0 x2 t2)  dist x1 x2 * exp ((L + 1) * ¦t2 - t0¦)"
      unfolding dist_norm
    proof (rule exponential_initial_condition[where Y = "cball x0 (2 * u)"])
      fix s assume "s  closed_segment t0 t2" hence s: "s  cball t0 t"
        using t2
        by (auto simp: dist_real_def closed_segment_eq_real_ivl split: if_split_asm)
      show "flow t0 x1 s  cball x0 (2 * u)"
        by (rule flow_in_cball[OF s x1])
      show "flow t0 x2 s  cball x0 (2 * u)"
        by (rule flow_in_cball[OF s x2])
      show "L-lipschitz_on (cball x0 (2 * u)) (f s)" if "s  closed_segment t0 t2" for s
        using that centre_in_cball convex_contains_segment less_imp_le t2 tu(1)
        by (blast intro!: lipschitz)
    qed (fact)+
    also have "  dist x1 x2 * exp ((L + 1) * ¦t¦)"
      using u > 0 t2
      by (auto
        intro!: mult_left_mono add_nonneg_nonneg lipschitz[THEN lipschitz_on_nonneg]
        simp: cball_eq_empty cball_eq_sing' dist_real_def)
    also
    have "x1  X"
      using x1 subs[of x0] u > 0
      by auto
    have *: "¦t0 - t1¦  t  x  {t0--t1}  ¦t0 - x¦  t"
      "¦t0 - t2¦  t  x  {t0--t2}  ¦t0 - x¦  t"
      "¦t0 - t1¦  t  ¦t0 - t2¦  t  x  {t1--t2}  ¦t0 - x¦  t"
      for x
      using t1 t2 t1_ex x1 flow_in_cball[OF _ x1]
      by (auto simp: closed_segment_eq_real_ivl split: if_splits)

    have integrable:
      "(λt. f t (flow t0 x1 t)) integrable_on {t0--t1}"
      "(λt. f t (flow t0 x1 t)) integrable_on {t0--t2}"
      "(λt. f t (flow t0 x1 t)) integrable_on {t1--t2}"
      using t1 t2 t1_ex x1 flow_in_cball[OF _ x1]
      by (auto intro!: order_trans[OF integral_bound[where B=B]] cont_on_f_flow B
        integrable_continuous_closed_segment
        intro: *
        simp: dist_real_def integral_minus_sets')

    have *: "¦t0 - t1¦  t  ¦t0 - t2¦  t  s  {t1--t2}  ¦t0 - s¦  t" for s
      by (auto simp: closed_segment_eq_real_ivl split: if_splits)
    note [simp] = t1_ex t2_ex x1  X integrable
    have "dist (flow t0 x1 t1) (flow t0 x1 t2)  dist t1 t2 * B"
      using t1 t2 x1 flow_in_cball[OF _ x1] t0  T
        ivl_integral_combine[of "λt. f t (flow t0 x1 t)" t2 t0 t1]
        ivl_integral_combine[of "λt. f t (flow t0 x1 t)" t1 t0 t2]
      by (auto simp: flow_fixed_point dist_norm add.commute closed_segment_commute
          norm_minus_commute ivl_integral_minus_sets' ivl_integral_minus_sets
        intro!: order_trans[OF ivl_integral_bound[where B=B]] cont_on_f_flow B dest: *)
    finally
    have "dist (flow t0 x1 t1) (flow t0 x2 t2) 
        dist t1 t2 * B + dist x1 x2 * exp ((L + 1) * ¦t¦)"
      by arith
    also have "  dist (t1, x1) (t2, x2) * B + dist (t1, x1) (t2, x2) * exp ((L + 1) * ¦t¦)"
      using B > 0
      by (auto intro!: add_mono mult_right_mono simp: dist_prod_def)
    finally show "dist (flow t0 x1 t1) (flow t0 x2 t2)
        (B + exp ((L + 1) * ¦t¦)) * dist (t1, x1) (t2, x2)"
      by (simp add: algebra_simps)
  qed (simp add: 0 < B less_imp_le)
  ultimately
  show thesis using subs tu ..
qed

context
fixes x0
assumes iv_defined: "t0  T" "x0  X"
begin

lemma existence_ivl_notempty: "existence_ivl t0 x0  {}"
  using existence_ivl_initial_time iv_defined
  by auto

lemma initial_time_bounds:
  shows "bdd_above (existence_ivl t0 x0)  t0 < Sup (existence_ivl t0 x0)" (is "?a  _")
    and "bdd_below (existence_ivl t0 x0)  Inf (existence_ivl t0 x0) < t0" (is "?b  _")
proof -
  from local_unique_solutions[OF iv_defined]
  obtain te where te: "te > 0" "cball t0 te  existence_ivl t0 x0"
    by metis
  then
  show "t0 < Sup (existence_ivl t0 x0)" if bdd: "bdd_above (existence_ivl t0 x0)"
    using less_cSup_iff[OF existence_ivl_notempty bdd, of t0] iv_defined
    by (auto simp: dist_real_def intro!: bexI[where x="t0 + te"])

  from te show "Inf (existence_ivl t0 x0) < t0" if bdd: "bdd_below (existence_ivl t0 x0)"
    unfolding cInf_less_iff[OF existence_ivl_notempty bdd, of t0]
    by (auto simp: dist_real_def iv_defined intro!: bexI[where x="t0 - te"])
qed

lemma
  flow_leaves_compact_ivl_right:
  assumes bdd: "bdd_above (existence_ivl t0 x0)"
  defines "b  Sup (existence_ivl t0 x0)"
  assumes "b  T"
  assumes "compact K"
  assumes "K  X"
  obtains t where "t  t0" "t  existence_ivl t0 x0" "flow t0 x0 t  K"
proof (atomize_elim, rule ccontr, auto)
  note iv_defined
  note ne = existence_ivl_notempty
  assume K[rule_format]: "t. t  existence_ivl t0 x0  t0  t  flow t0 x0 t  K"
  have b_upper: "t  b" if "t  existence_ivl t0 x0" for t
    unfolding b_def
    by (rule cSup_upper[OF that bdd])

  have less_b_iff: "y < b  (xexistence_ivl t0 x0. y < x)" for y
    unfolding b_def less_cSup_iff[OF ne bdd] ..
  have "t0  b"
    by (simp add: iv_defined b_upper)
  then have geI: "t  {t0--<b}  t0  t" for t
    by (auto simp: half_open_segment_real)
  have subset: "{t0 --< b}  existence_ivl t0 x0"
    using t0  b in_existence_between_zeroI
    by (auto simp: half_open_segment_real iv_defined less_b_iff)
  have sol: "(flow t0 x0 solves_ode f) {t0 --< b} K"
    apply (rule solves_odeI)
    apply (rule has_vderiv_on_subset[OF solves_odeD(1)[OF flow_solves_ode] subset])
    using subset iv_defined
    by (auto intro!: K geI)
  have cont: "continuous_on ({t0--b} × K) (λ(t, x). f t x)"
    using K  X closed_segment_subset_domainI[OF iv_defined(1) b  T]
    by (auto simp: split_beta intro!: continuous_intros)

  from initial_time_bounds(1)[OF bdd] have "t0  b" by (simp add: b_def)
  from solves_ode_half_open_segment_continuation[OF sol cont ‹compact K t0  b]
  obtain l where lim: "(flow t0 x0  l) (at b within {t0--<b})"
    and limsol: "((λt. if t = b then l else flow t0 x0 t) solves_ode f) {t0--b} K" .
  have "b  existence_ivl t0 x0"
    using t0  b closed_segment_subset_domainI[OF t0  T b  T]
    by (intro existence_ivl_maximal_segment[OF solves_ode_on_subset[OF limsol order_refl K  X]])
      (auto simp: iv_defined)

  have "flow t0 x0 b  X"
    by (simp add: b  existence_ivl t0 x0 flow_in_domain iv_defined)

  from ll_on_open_it.local_unique_solutions[OF ll_on_open_it_axioms b  T ‹flow t0 x0 b  X]
  obtain e where "e > 0" "cball b e  existence_ivl b (flow t0 x0 b)"
    by metis
  then have "e + b  existence_ivl b (flow t0 x0 b)"
    by (auto simp: dist_real_def)
  from existence_ivl_trans[OF b  existence_ivl t0 x0 e + b  existence_ivl _ _]
  have "b + e  existence_ivl t0 x0" .
  from b_upper[OF this] e > 0
  show False
    by simp
qed

lemma
  flow_leaves_compact_ivl_left:
  assumes bdd: "bdd_below (existence_ivl t0 x0)"
  defines "b  Inf (existence_ivl t0 x0)"
  assumes "b  T"
  assumes "compact K"
  assumes "K  X"
  obtains t where "t  t0" "t  existence_ivl t0 x0" "flow t0 x0 t  K"
proof -
  interpret rev: ll_on_open "(preflect t0 ` T)" "(λt. - f (preflect t0 t))" X ..
  from antimono_preflect bdd have bdd_rev: "bdd_above (rev.existence_ivl t0 x0)"
    unfolding rev_existence_ivl_eq
    by (rule bdd_above_image_antimono)
  note ne = existence_ivl_notempty
  have "Sup (rev.existence_ivl t0 x0) = preflect t0 b"
    using continuous_at_Inf_antimono[OF antimono_preflect _ ne bdd]
    by (simp add: continuous_preflect b_def rev_existence_ivl_eq)
  then have Sup_mem: "Sup (rev.existence_ivl t0 x0)  preflect t0 ` T"
    using b  T by auto

  have rev_iv: "t0  preflect t0 ` T" "x0  X" using iv_defined by auto
  from rev.flow_leaves_compact_ivl_right[OF rev_iv bdd_rev Sup_mem ‹compact K K  X]
  obtain t where "t0  t" "t  rev.existence_ivl t0 x0" "rev.flow t0 x0 t  K" .

  then have "preflect t0 t  t0" "preflect t0 t  existence_ivl t0 x0" "flow t0 x0 (preflect t0 t)  K"
    by (auto simp: rev_existence_ivl_eq rev_flow_eq)
  thus ?thesis ..
qed

lemma
  sup_existence_maximal:
  assumes "t. t0  t  t  existence_ivl t0 x0  flow t0 x0 t  K"
  assumes "compact K" "K  X"
  assumes "bdd_above (existence_ivl t0 x0)"
  shows "Sup (existence_ivl t0 x0)  T"
  using flow_leaves_compact_ivl_right[of K] assms by force

lemma
  inf_existence_minimal:
  assumes "t. t  t0  t  existence_ivl t0 x0  flow t0 x0 t  K"
  assumes "compact K" "K  X"
  assumes "bdd_below (existence_ivl t0 x0)"
  shows "Inf (existence_ivl t0 x0)  T"
  using flow_leaves_compact_ivl_left[of K] assms
  by force

end

lemma
  subset_mem_compact_implies_subset_existence_interval:
  assumes ivl: "t0  T'" "is_interval T'" "T'  T"
  assumes iv_defined: "x0  X"
  assumes mem_compact: "t. t  T'  t  existence_ivl t0 x0  flow t0 x0 t  K"
  assumes K: "compact K" "K  X"
  shows "T'  existence_ivl t0 x0"
proof (rule ccontr)
  assume "¬ T'  existence_ivl t0 x0"
  then obtain t' where t': "t'  existence_ivl t0 x0" "t'  T'"
    by auto
  from assms have iv_defined: "t0  T" "x0  X" by auto
  show False
  proof (cases rule: not_in_connected_cases[OF connected_existence_ivl t'(1) existence_ivl_notempty[OF iv_defined]])
    assume bdd: "bdd_below (existence_ivl t0 x0)"
    assume t'_lower: "t'  y" if "y  existence_ivl t0 x0" for y
    have i: "Inf (existence_ivl t0 x0)  T'"
      using initial_time_bounds[OF iv_defined] iv_defined
      apply -
      by (rule mem_is_intervalI[of _ t' t0])
        (auto simp: ivl t' bdd intro!: t'_lower cInf_greatest[OF existence_ivl_notempty[OF iv_defined]])
    have *: "t  T'" if "t  t0" "t  existence_ivl t0 x0" for t
      by (rule mem_is_intervalI[OF ‹is_interval T' i t0  T']) (auto intro!: cInf_lower that bdd)
    from inf_existence_minimal[OF iv_defined mem_compact K bdd, OF *]
    show False using i ivl by auto
  next
    assume bdd: "bdd_above (existence_ivl t0 x0)"
    assume t'_upper: "y  t'" if "y  existence_ivl t0 x0" for y
    have s: "Sup (existence_ivl t0 x0)  T'"
      using initial_time_bounds[OF iv_defined]
      apply -
      apply (rule mem_is_intervalI[of _ t0 t'])
      by (auto simp: ivl t' bdd intro!: t'_upper cSup_least[OF existence_ivl_notempty[OF iv_defined]])
    have *: "t  T'" if "t0  t" "t  existence_ivl t0 x0" for t
      by (rule mem_is_intervalI[OF ‹is_interval T' t0  T' s]) (auto intro!: cSup_upper that bdd)
    from sup_existence_maximal[OF iv_defined mem_compact K bdd, OF *]
    show False using s ivl by auto
  qed
qed

lemma
  mem_compact_implies_subset_existence_interval:
  assumes iv_defined: "t0  T" "x0  X"
  assumes mem_compact: "t. t  T  t  existence_ivl t0 x0  flow t0 x0 t  K"
  assumes K: "compact K" "K  X"
  shows "T  existence_ivl t0 x0"
  by (rule subset_mem_compact_implies_subset_existence_interval; (fact | rule order_refl interval iv_defined))

lemma
  global_right_existence_ivl_explicit:
  assumes "b  t0"
  assumes b: "b  existence_ivl t0 x0"
  obtains d K where "d > 0" "K > 0"
    "ball x0 d  X"
    "y. y  ball x0 d  b  existence_ivl t0 y"
    "t y. y  ball x0 d  t  {t0 .. b} 
      dist (flow t0 x0 t) (flow t0 y t)  dist x0 y * exp (K * abs (t - t0))"
proof -
  note iv_defined = mem_existence_ivl_iv_defined[OF b]
  define seg where "seg  (λt. flow t0 x0 t) ` (closed_segment t0 b)"
  have [simp]: "x0  seg"
    by (auto simp: seg_def intro!: image_eqI[where x=t0] simp: closed_segment_eq_real_ivl iv_defined)
  have "seg  {}" by (auto simp: seg_def closed_segment_eq_real_ivl)
  moreover
  have "compact seg"
    using iv_defined b
    by (auto simp: seg_def closed_segment_eq_real_ivl
        intro!: compact_continuous_image continuous_at_imp_continuous_on flow_continuous;
      metis (erased, hide_lams) atLeastAtMost_iff closed_segment_eq_real_ivl
        closed_segment_subset_existence_ivl contra_subsetD order.trans)
  moreover note open_domain(2)
  moreover have "seg  X"
    using closed_segment_subset_existence_ivl b
    by (auto simp: seg_def intro!: flow_in_domain iv_defined)
  ultimately
  obtain e where e: "0 < e" "{x. infdist x seg  e}  X"
    thm compact_in_open_separated
    by (rule compact_in_open_separated)
  define A where "A  {x. infdist x seg  e}"

  have "A  X" using e by (simp add: A_def)

  have mem_existence_ivlI: "s. t0  s  s  b  s  existence_ivl t0 x0"
    by (rule in_existence_between_zeroI[OF b]) (auto simp: closed_segment_eq_real_ivl)

  have "compact A"
    unfolding A_def
    by (rule compact_infdist_le) fact+
  have "compact {t0 .. b}" "{t0 .. b}  T"
    subgoal by simp
    subgoal
      using mem_existence_ivlI mem_existence_ivl_subset[of _ x0] iv_defined b ivl_subset_existence_ivl
      by blast
    done
  from lipschitz_on_compact[OF this ‹compact A A  X]
  obtain K' where K': "t. t  {t0 .. b}  K'-lipschitz_on A (f t)"
    by metis
  define K where "K  K' + 1"
  have "0 < K" "0  K"
    using assms lipschitz_on_nonneg[OF K', of t0]
    by (auto simp: K_def)
  have K: "t. t  {t0 .. b}  K-lipschitz_on A (f t)"
    unfolding K_def
    using _  lipschitz_on K' A _
    by (rule lipschitz_on_mono) auto

  have [simp]: "x0  A" using 0 < e by (auto simp: A_def)


  define d where "d  min e (e * exp (-K * (b - t0)))"
  hence d: "0 < d" "d  e" "d  e * exp (-K * (b - t0))"
    using e by auto

  have d_times_exp_le: "d * exp (K * (t - t0))  e" if "t0  t" "t  b" for t
  proof -
    from that have "d * exp (K * (t - t0))  d * exp (K * (b - t0))"
      using 0  K 0 < d
      by (auto intro!: mult_left_mono)
    also have "d * exp (K * (b - t0))  e"
      using d by (auto simp: exp_minus divide_simps)
    finally show ?thesis .
  qed
  have "ball x0 d  X" using d A  X
    by (auto simp: A_def dist_commute intro!: infdist_le2[where a=x0])
  note iv_defined
  {
    fix y
    assume y: "y  ball x0 d"
    hence "y  A" using d
      by (auto simp: A_def dist_commute intro!: infdist_le2[where a=x0])
    hence "y  X" using A  X by auto
    note y_iv = t0  T y  X
    have in_A: "flow t0 y t  A" if t: "t0  t" "t  existence_ivl t0 y" "t  b" for t
    proof (rule ccontr)
      assume flow_out: "flow t0 y t  A"
      obtain t' where t':
        "t0  t'"
        "t'  t"
        "t. t  {t0 .. t'}  flow t0 x0 t  A"
        "infdist (flow t0 y t') seg  e"
        "t. t  {t0 .. t'}  flow t0 y t  A"
      proof -
        let ?out = "((λt. infdist (flow t0 y t) seg) -` {e..})  {t0..t}"
        have "compact ?out"
          unfolding compact_eq_bounded_closed
        proof safe
          show "bounded ?out" by (auto intro!: bounded_closed_interval)
          have "continuous_on {t0 .. t} ((λt. infdist (flow t0 y t) seg))"
            using closed_segment_subset_existence_ivl t iv_defined
            by (force intro!: continuous_at_imp_continuous_on
              continuous_intros flow_continuous
              simp: closed_segment_eq_real_ivl)
          thus "closed ?out"
            by (simp add: continuous_on_closed_vimage)
        qed
        moreover
        have "t  (λt. infdist (flow t0 y t) seg) -` {e..}  {t0..t}"
          using flow_out t0  t
          by (auto simp: A_def)
        hence "?out  {}"
          by blast
        ultimately have "s?out. t?out. s  t"
          by (rule compact_attains_inf)
        then obtain t' where t':
          "s. e  infdist (flow t0 y s) seg  t0  s  s  t  t'  s"
          "e  infdist (flow t0 y t') seg"
          "t0  t'" "t'  t"
          by (auto simp: vimage_def Ball_def) metis
        have flow_in: "flow t0 x0 s  A" if s: "s  {t0 .. t'}" for s
        proof -
          from s have "s  closed_segment t0 b"
            using t  b t' by (auto simp: closed_segment_eq_real_ivl)
          then show ?thesis
            using s e > 0 by (auto simp: seg_def A_def)
        qed
        have "flow t0 y t'  A" if "t' = t0"
          using y d iv_defined that
          by (auto simp:  A_def y  X infdist_le2[where a=x0] dist_commute)
        moreover
        have "flow t0 y s  A" if s: "s  {t0 ..< t'}" for s
        proof -
          from s have "s  closed_segment t0 b"
            using t  b t' by (auto simp: closed_segment_eq_real_ivl)
          from t'(1)[of s]
          have "t' > s  t0  s  s  t  e > infdist (flow t0 y s) seg"
            by force
          then show ?thesis
            using s t' e > 0 by (auto simp: seg_def A_def)
        qed
        moreover
        note left_of_in = this
        have "closed A" using ‹compact A by (auto simp: compact_eq_bounded_closed)
        have "((λs. flow t0 y s)  flow t0 y t') (at_left t')"
          using closed_segment_subset_existence_ivl[OF t(2)] t' y  X iv_defined
          by (intro flow_tendsto) (auto intro!: tendsto_intros simp: closed_segment_eq_real_ivl)
        with ‹closed A _ _ have "t'  t0  flow t0 y t'  A"
        proof (rule Lim_in_closed_set)
          assume "t'  t0"
          hence "t' > t0" using t' by auto
          hence "eventually (λx. x  t0) (at_left t')"
            by (metis eventually_at_left less_imp_le)
          thus "eventually (λx. flow t0 y x  A) (at_left t')"
            unfolding eventually_at_filter
            by eventually_elim (auto intro!: left_of_in)
        qed simp
        ultimately have flow_y_in: "s  {t0 .. t'}  flow t0 y s  A" for s
          by (cases "s = t'"; fastforce)
        have
          "t0  t'"
          "t'  t"
          "t. t  {t0 .. t'}  flow t0 x0 t  A"
          "infdist (flow t0 y t') seg  e"
          "t. t  {t0 .. t'}  flow t0 y t  A"
          by (auto intro!: flow_in flow_y_in) fact+
        thus ?thesis ..
      qed
      {
        fix s assume s: "s  {t0 .. t'}"
        hence "t0  s" by simp
        have "s  b"
          using t t' s b
          by auto
        hence sx0: "s  existence_ivl t0 x0"
          by (simp add: t0  s mem_existence_ivlI)
        have sy: "s  existence_ivl t0 y"
          by (meson atLeastAtMost_iff contra_subsetD s t'(1) t'(2) that(2) ivl_subset_existence_ivl)
        have int: "flow t0 y s - flow t0 x0 s =
            y - x0 + (integral {t0 .. s} (λt. f t (flow t0 y t)) -
              integral {t0 .. s} (λt. f t (flow t0 x0 t)))"
          using iv_defined s
          unfolding flow_fixed_point[OF sx0] flow_fixed_point[OF sy]
          by (simp add: algebra_simps ivl_integral_def)
        have "norm (flow t0 y s - flow t0 x0 s)  norm (y - x0) +
          norm (integral {t0 .. s} (λt. f t (flow t0 y t)) -
            integral {t0 .. s} (λt. f t (flow t0 x0 t)))"
          unfolding int
          by (rule norm_triangle_ineq)
        also
        have "norm (integral {t0 .. s} (λt. f t (flow t0 y t)) -
            integral {t0 .. s} (λt. f t (flow t0 x0 t))) =
          norm (integral {t0 .. s} (λt. f t (flow t0 y t) - f t (flow t0 x0 t)))"
          using closed_segment_subset_existence_ivl[of s x0] sx0 closed_segment_subset_existence_ivl[of s y] sy
          by (subst Henstock_Kurzweil_Integration.integral_diff)
            (auto intro!: integrable_continuous_real continuous_at_imp_continuous_on
              f_flow_continuous
              simp: closed_segment_eq_real_ivl)
        also have "  (integral {t0 .. s} (λt. norm (f t (flow t0 y t) - f t (flow t0 x0 t))))"
          using closed_segment_subset_existence_ivl[of s x0] sx0 closed_segment_subset_existence_ivl[of s y] sy
          by (intro integral_norm_bound_integral)
            (auto intro!: integrable_continuous_real continuous_at_imp_continuous_on
            f_flow_continuous continuous_intros
              simp: closed_segment_eq_real_ivl)
      also have "  (integral {t0 .. s} (λt. K * norm ((flow t0 y t) - (flow t0 x0 t))))"
          using closed_segment_subset_existence_ivl[of s x0] sx0 closed_segment_subset_existence_ivl[of s y] sy
            iv_defined s t'(3,5) s  b
          by (auto simp del: Henstock_Kurzweil_Integration.integral_mult_right intro!: integral_le integrable_continuous_real
            continuous_at_imp_continuous_on lipschitz_on_normD[OF K]
            flow_continuous f_flow_continuous continuous_intros
            simp: closed_segment_eq_real_ivl)
        also have " = K * integral {t0 .. s} (λt. norm (flow t0 y t - flow t0 x0 t))"
          using closed_segment_subset_existence_ivl[of s x0] sx0 closed_segment_subset_existence_ivl[of s y] sy
          by (subst integral_mult)
             (auto intro!: integrable_continuous_real continuous_at_imp_continuous_on
               lipschitz_on_normD[OF K] flow_continuous f_flow_continuous continuous_intros
               simp: closed_segment_eq_real_ivl)
        finally
        have norm: "norm (flow t0 y s - flow t0 x0 s) 
          norm (y - x0) + K * integral {t0 .. s} (λt. norm (flow t0 y t - flow t0 x0 t))"
          by arith
        note norm s  b sx0 sy
      } note norm_le = this
      from norm_le(2) t' have "t'  closed_segment t0 b"
        by (auto simp: closed_segment_eq_real_ivl)
      hence "infdist (flow t0 y t') seg  dist (flow t0 y t') (flow t0 x0 t')"
        by (auto simp: seg_def infdist_le)
      also have "  norm (flow t0 y t' - flow t0 x0 t')"
        by (simp add: dist_norm)
      also have "  norm (y - x0) * exp (K * ¦t' - t0¦)"
        unfolding K_def
        apply (rule exponential_initial_condition[OF _ _ _ _ _ K'])
        subgoal by (metis atLeastAtMost_iff local.norm_le(4) order_refl t'(1))
        subgoal by (metis atLeastAtMost_iff local.norm_le(3) order_refl t'(1))
        subgoal using e by (simp add: A_def)
        subgoal by (metis closed_segment_eq_real_ivl t'(1,5))
        subgoal by (metis closed_segment_eq_real_ivl t'(1,3))
        subgoal by (simp add: closed_segment_eq_real_ivl local.norm_le(2) t'(1))
        done
      also have " < d * exp (K * (t - t0))"
        using y d t' t
        by (intro mult_less_le_imp_less)
           (auto simp: dist_norm[symmetric] dist_commute intro!: mult_mono 0  K)
      also have "  e"
        by (rule d_times_exp_le; fact)
      finally
      have "infdist (flow t0 y t') seg < e" .
      with ‹infdist (flow t0 y t') seg  e show False
        by (auto simp: frontier_def)
    qed

    have "{t0..b}  existence_ivl t0 y"
    by (rule subset_mem_compact_implies_subset_existence_interval[OF
      _ is_interval_cc {t0..b}  T y  X in_A ‹compact A A  X])
      (auto simp: t0  b)
    with t0  b have b_in: "b  existence_ivl t0 y"
      by force
    {
      fix t assume t: "t  {t0 .. b}"
      also have "{t0 .. b} = {t0 -- b}"
        by (auto simp: closed_segment_eq_real_ivl assms)
      also note closed_segment_subset_existence_ivl[OF b_in]
      finally have t_in: "t  existence_ivl t0 y" .

      note t
      also note {t0 .. b} = {t0 -- b}
      also note closed_segment_subset_existence_ivl[OF assms(2)]
      finally have t_in': "t  existence_ivl t0 x0" .
      have "norm (flow t0 y t - flow t0 x0 t)  norm (y - x0) * exp (K * ¦t - t0¦)"
        unfolding K_def
        using t closed_segment_subset_existence_ivl[OF b_in] 0 < e
        by (intro in_A exponential_initial_condition[OF t_in t_in' A  X _ _ K'])
          (auto simp: closed_segment_eq_real_ivl A_def seg_def)
      hence "dist (flow t0 x0 t) (flow t0 y t)  dist x0 y * exp (K * ¦t - t0¦)"
        by (auto simp: dist_norm[symmetric] dist_commute)
    }
    note b_in this
  } from d > 0 K > 0 ‹ball x0 d  X this show ?thesis ..
qed

lemma
  global_left_existence_ivl_explicit:
  assumes "b  t0"
  assumes b: "b  existence_ivl t0 x0"
  assumes iv_defined: "t0  T" "x0  X"
  obtains d K where "d > 0" "K > 0"
    "ball x0 d  X"
    "y. y  ball x0 d  b  existence_ivl t0 y"
    "t y. y  ball x0 d  t  {b .. t0}  dist (flow t0 x0 t) (flow t0 y t)  dist x0 y * exp (K * abs (t - t0))"
proof -
  interpret rev: ll_on_open "(preflect t0 ` T)" "(λt. - f (preflect t0 t))" X ..
  have t0': "t0  preflect t0 ` T" "x0  X"
    by (auto intro!: iv_defined)
  from assms have "preflect t0 b  t0" "preflect t0 b  rev.existence_ivl t0 x0"
    by (auto simp: rev_existence_ivl_eq)
  from rev.global_right_existence_ivl_explicit[OF this]
  obtain d K where dK: "d > 0" "K > 0"
    "ball x0 d  X"
    "y. y  ball x0 d  preflect t0 b  rev.existence_ivl t0 y"
    "t y. y  ball x0 d  t  {t0 .. preflect t0 b}  dist (rev.flow t0 x0 t) (rev.flow t0 y t)  dist x0 y * exp (K * abs (t - t0))"
    by (auto simp: rev_flow_eq x0  X)

  have ex_ivlI: "dist x0 y < d  t  existence_ivl t0 y" if "b  t" "t  t0" for t y
    using that dK(4)[of y] dK(3) iv_defined
    by (auto simp: subset_iff rev_existence_ivl_eq[of ]
      closed_segment_eq_real_ivl iv_defined in_existence_between_zeroI)
  have "b  existence_ivl t0 y" if "dist x0 y < d" for y
    using that dK
    by (subst existence_ivl_eq_rev) (auto simp: iv_defined intro!: image_eqI[where x="preflect t0 b"])
  with dK have "d > 0" "K > 0"
    "ball x0 d  X"
    "y. y  ball x0 d  b  existence_ivl t0 y"
    "t y. y  ball x0 d  t  {b .. t0}  dist (flow t0 x0 t) (flow t0 y t)  dist x0 y * exp (K * abs (t - t0))"
    by (auto simp: flow_eq_rev iv_defined ex_ivlI x0  X subset_iff
      intro!: order_trans[OF dK(5)] image_eqI[where x="preflect t0 b"])
  then show ?thesis ..
qed

lemma
  global_existence_ivl_explicit:
  assumes a: "a  existence_ivl t0 x0"
  assumes b: "b  existence_ivl t0 x0"
  assumes le: "a  b"
  obtains d K where "d > 0" "K > 0"
    "ball x0 d  X"
    "y. y  ball x0 d  a  existence_ivl t0 y"
    "y. y  ball x0 d  b  existence_ivl t0 y"
    "t y. y  ball x0 d  t  {a .. b} 
      dist (flow t0 x0 t) (flow t0 y t)  dist x0 y * exp (K * abs (t - t0))"
proof -
  note iv_defined = mem_existence_ivl_iv_defined[OF a]
  define r where "r  Max {t0, a, b}"
  define l where "l  Min {t0, a, b}"
  have r: "r  t0" "r  existence_ivl t0 x0"
    using a b by (auto simp: max_def r_def iv_defined)
  obtain dr Kr where right:
    "0 < dr" "0 < Kr" "ball x0 dr  X"
    "y. y  ball x0 dr  r  existence_ivl t0 y"
    "y t. y  ball x0 dr  t  {t0..r}  dist (flow t0 x0 t) (flow t0 y t)  dist x0 y * exp (Kr * ¦t - t0¦)"
    by (rule global_right_existence_ivl_explicit[OF r]) blast

  have l: "l  t0" "l  existence_ivl t0 x0"
    using a b by (auto simp: min_def l_def iv_defined)
  obtain dl Kl where left:
    "0 < dl" "0 < Kl" "ball x0 dl  X"
    "y. y  ball x0 dl  l  existence_ivl t0 y"
    "y t. y  ball x0 dl  t  {l .. t0}  dist (flow t0 x0 t) (flow t0 y t)  dist x0 y * exp (Kl * ¦t - t0¦)"
    by (rule global_left_existence_ivl_explicit[OF l iv_defined]) blast

  define d where "d  min dr dl"
  define K where "K  max Kr Kl"

  note iv_defined
  have "0 < d" "0 < K" "ball x0 d  X"
    using left right by (auto simp: d_def K_def)
  moreover
  {
    fix y assume y: "y  ball x0 d"
    hence "y  X" using ‹ball x0 d  X by auto
    from y
      closed_segment_subset_existence_ivl[OF left(4), of y]
      closed_segment_subset_existence_ivl[OF right(4), of y]
    have "a  existence_ivl t0 y" "b  existence_ivl t0 y"
      by (auto simp: d_def l_def r_def min_def max_def closed_segment_eq_real_ivl split: if_split_asm)
  }
  moreover
  {
    fix t y
    assume y: "y  ball x0 d"
      and t: "t  {a .. b}"
    from y have "y  X" using ‹ball x0 d  X by auto
    have "dist (flow t0 x0 t) (flow t0 y t)  dist x0 y * exp (K * abs (t - t0))"
    proof cases
      assume "t  t0"
      hence "dist (flow t0 x0 t) (flow t0 y t)  dist x0 y * exp (Kr * abs (t - t0))"
        using y t
        by (intro right) (auto simp: d_def r_def)
      also have "exp (Kr * abs (t - t0))  exp (K * abs (t - t0))"
        by (auto simp: mult_left_mono K_def max_def mult_right_mono)
      finally show ?thesis by (simp add: mult_left_mono)
    next
      assume "¬t  t0"
      hence "dist (flow t0 x0 t) (flow t0 y t)  dist x0 y * exp (Kl * abs (t - t0))"
        using y t
        by (intro left) (auto simp: d_def l_def)
      also have "exp (Kl * abs (t - t0))  exp (K * abs (t - t0))"
        by (auto simp: mult_left_mono K_def max_def mult_right_mono)
      finally show ?thesis by (simp add: mult_left_mono)
    qed
  } ultimately show ?thesis ..
qed

lemma eventually_exponential_separation:
  assumes a: "a  existence_ivl t0 x0"
  assumes b: "b  existence_ivl t0 x0"
  assumes le: "a  b"
  obtains K where "K > 0" "F y in at x0. t{a..b}. dist (flow t0 x0 t) (flow t0 y t)  dist x0 y * exp (K * ¦t - t0¦)"
proof -
  from global_existence_ivl_explicit[OF assms]
  obtain d K where *: "d > 0" "K > 0"
    "ball x0 d  X"
    "y. y  ball x0 d  a  existence_ivl t0 y"
    "y. y  ball x0 d  b  existence_ivl t0 y"
    "t y. y  ball x0 d  t  {a .. b} 
      dist (flow t0 x0 t) (flow t0 y t)  dist x0 y * exp (K * abs (t - t0))"
    by auto
  note K > 0
  moreover
  have "eventually (λy. y  ball x0 d) (at x0)"
    using d > 0[THEN eventually_at_ball]
    by eventually_elim simp
  hence "eventually (λy. t{a..b}. dist (flow t0 x0 t) (flow t0 y t)  dist x0 y * exp (K * ¦t - t0¦)) (at x0)"
    by eventually_elim (safe intro!: *)
  ultimately show ?thesis ..
qed

lemma eventually_mem_existence_ivl:
  assumes b: "b  existence_ivl t0 x0"
  shows "F x in at x0. b  existence_ivl t0 x"
proof -
  from mem_existence_ivl_iv_defined[OF b] have iv_defined: "t0  T" "x0  X" by simp_all
  note eiit = existence_ivl_initial_time[OF iv_defined]
  {
    fix a b
    assume assms: "a  existence_ivl t0 x0" "b  existence_ivl t0 x0" "a  b"
    from global_existence_ivl_explicit[OF assms]
    obtain d K where *: "d > 0" "K > 0"
      "ball x0 d  X"
      "y. y  ball x0 d  a  existence_ivl t0 y"
      "y. y  ball x0 d  b  existence_ivl t0 y"
      "t y. y  ball x0 d  t  {a .. b} 
        dist (flow t0 x0 t) (flow t0 y t)  dist x0 y * exp (K * abs (t - t0))"
      by auto
    have "eventually (λy. y  ball x0 d) (at x0)"
      using d > 0[THEN eventually_at_ball]
      by eventually_elim simp
    then have "F x in at x0. a  existence_ivl t0 x  b  existence_ivl t0 x"
      by (eventually_elim) (auto intro!: *)
  } from this[OF b eiit] this[OF eiit b]
  show ?thesis
    by (cases "t0  b") (auto simp: eventually_mono)
qed

lemma uniform_limit_flow:
  assumes a: "a  existence_ivl t0 x0"
  assumes b: "b  existence_ivl t0 x0"
  assumes le: "a  b"
  shows "uniform_limit {a .. b} (flow t0) (flow t0 x0) (at x0)"
proof (rule uniform_limitI)
  fix e::real assume "0 < e"
  from eventually_exponential_separation[OF assms] obtain K where "0 < K"
    "F y in at x0. t{a..b}. dist (flow t0 x0 t) (flow t0 y t)  dist x0 y * exp (K * ¦t - t0¦)"
    by auto
  note this(2)
  moreover
  let ?m = "max (abs (b - t0)) (abs (a - t0))"
  have "eventually (λy. t{a..b}. dist x0 y * exp (K * ¦t - t0¦)  dist x0 y * exp (K * ?m)) (at x0)"
    using a  b 0 < K
    by (auto intro!: mult_left_mono always_eventually)
  moreover
  have "eventually (λy. dist x0 y * exp (K * ?m) < e) (at x0)"
    using 0 < e by (auto intro!: order_tendstoD tendsto_eq_intros)
  ultimately
  show "eventually (λy. t{a..b}. dist (flow t0 y t) (flow t0 x0 t) < e) (at x0)"
    by eventually_elim (force simp: dist_commute)
qed

lemma eventually_at_fst:
  assumes "eventually P (at (fst x))"
  assumes "P (fst x)"
  shows "eventually (λh. P (fst h)) (at x)"
  using assms
  unfolding eventually_at_topological
  by (metis open_vimage_fst rangeI range_fst vimageE vimageI)

lemma eventually_at_snd:
  assumes "eventually P (at (snd x))"
  assumes "P (snd x)"
  shows "eventually (λh. P (snd h)) (at x)"
  using assms
  unfolding eventually_at_topological
  by (metis open_vimage_snd rangeI range_snd vimageE vimageI)

lemma
  shows open_state_space: "open (Sigma X (existence_ivl t0))"
  and flow_continuous_on_state_space:
    "continuous_on (Sigma X (existence_ivl t0)) (λ(x, t). flow t0 x t)"
proof (safe intro!: topological_space_class.openI continuous_at_imp_continuous_on)
  fix t x assume "x  X" and t: "t  existence_ivl t0 x"
  have iv_defined: "t0  T" "x  X"
    using mem_existence_ivl_iv_defined[OF t] by auto
  from x  X t open_existence_ivl
  obtain e where e: "e > 0" "cball t e  existence_ivl t0 x"
    by (metis open_contains_cball)
  hence ivl: "t - e  existence_ivl t0 x" "t + e  existence_ivl t0 x" "t - e  t + e"
    by (auto simp: cball_def dist_real_def)
  obtain d K where dK:
    "0 < d" "0 < K" "ball x d  X"
    "y. y  ball x d  t - e  existence_ivl t0 y"
    "y. y  ball x d  t + e  existence_ivl t0 y"
    "y s. y  ball x d  s  {t - e..t + e} 
      dist (flow t0 x s) (flow t0 y s)  dist x y * exp (K * ¦s - t0¦)"
    by (rule global_existence_ivl_explicit[OF ivl]) blast
  let ?T = "ball x d × ball t e"
  have "open ?T" by (auto intro!: open_Times)
  moreover have "(x, t)  ?T" by (auto simp: dK 0 < e)
  moreover have "?T  Sigma X (existence_ivl t0)"
  proof safe
    fix s y assume y: "y  ball x d" and s: "s  ball t e"
    with ‹ball x d  X show "y  X" by auto
    have "ball t e  closed_segment t0 (t - e)  closed_segment t0 (t + e)"
      by (auto simp: closed_segment_eq_real_ivl dist_real_def)
    with y  X s closed_segment_subset_existence_ivl[OF dK(4)[OF y]]
      closed_segment_subset_existence_ivl[OF dK(5)[OF y]]
    show "s  existence_ivl t0 y"
      by auto
  qed
  ultimately show "T. open T  (x, t)  T  T  Sigma X (existence_ivl t0)"
    by blast
  have **: "F s in at 0. norm (flow t0 (x + fst s) (t + snd s) - flow t0 x t) < 2 * eps"
    if "eps > 0" for eps :: real
  proof -
    have "F s in at 0. norm (flow t0 (x + fst s) (t + snd s) - flow t0 x t) =
      norm (flow t0 (x + fst s) (t + snd s) - flow t0 x (t + snd s) +
        (flow t0 x (t + snd s) - flow t0 x t))"
      by auto
    moreover
    have "F s in at 0.
        norm (flow t0 (x + fst s) (t + snd s) - flow t0 x (t + snd s) +
          (flow t0 x (t + snd s) - flow t0 x t)) 
        norm (flow t0 (x + fst s) (t + snd s) - flow t0 x (t + snd s)) +
          norm (flow t0 x (t + snd s) - flow t0 x t)"
      by eventually_elim (rule norm_triangle_ineq)
    moreover
    have "F s in at 0. t + snd s  ball t e"
      by (auto simp: dist_real_def intro!: order_tendstoD[OF _ 0 < e]
        intro!: tendsto_eq_intros)
    moreover from uniform_limit_flow[OF ivl, THEN uniform_limitD, OF eps > 0]
    have "F (h::(_ )) in at (fst (0::'a*real)).
      t{t - e..t + e}. dist (flow t0 x t) (flow t0 (x + h) t) < eps"
      by (subst (asm) at_to_0)
        (auto simp: eventually_filtermap dist_commute ac_simps)
    hence "F (h::(_ * real)) in at 0.
      t{t - e..t + e}. dist (flow t0 x t) (flow t0 (x + fst h) t) < eps"
      by (rule eventually_at_fst) (simp add: eps > 0)
    moreover
    have "F h in at (snd (0::'a * _)). norm (flow t0 x (t + h) - flow t0 x t) < eps"
      using flow_continuous[OF t, unfolded isCont_def, THEN tendstoD, OF eps > 0]
      by (subst (asm) at_to_0)
        (auto simp: eventually_filtermap dist_norm ac_simps)
    hence "F h::('a * _) in at 0. norm (flow t0 x (t + snd h) - flow t0 x t) < eps"
      by (rule eventually_at_snd) (simp add: eps > 0)
    ultimately
    show ?thesis
    proof eventually_elim
      case (elim s)
      note elim(1)
      also note elim(2)
      also note elim(5)
      also
      from elim(3) have "t + snd s  {t - e..t + e}"
        by (auto simp: dist_real_def algebra_simps)
      from elim(4)[rule_format, OF this]
      have "norm (flow t0 (x + fst s) (t + snd s) - flow t0 x (t + snd s)) < eps"
        by (auto simp: dist_commute dist_norm[symmetric])
      finally
      show ?case by simp
    qed
  qed
  have *: "F s in at 0. norm (flow t0 (x + fst s) (t + snd s) - flow t0 x t) < eps"
    if "eps > 0" for eps::real
  proof -
    from that have "eps / 2 > 0" by simp
    from **[OF this] show ?thesis by auto
  qed
  show "isCont (λ(x, y). flow t0 x y) (x, t)"
    unfolding isCont_iff
    by (rule LIM_zero_cancel)
      (auto simp: split_beta' norm_conv_dist[symmetric] intro!: tendstoI *)
qed

lemmas flow_continuous_on_compose[continuous_intros] =
  continuous_on_compose_Pair[OF flow_continuous_on_state_space]

lemma flow_isCont_state_space: "t  existence_ivl t0 x0  isCont (λ(x, t). flow t0 x t) (x0, t)"
  using flow_continuous_on_state_space[of] mem_existence_ivl_iv_defined[of t x0]
  using continuous_on_eq_continuous_at open_state_space by fastforce

lemma
  flow_absolutely_integrable_on[integrable_on_simps]:
  assumes "s  existence_ivl t0 x0"
  shows "(λx. norm (flow t0 x0 x)) integrable_on closed_segment t0 s"
  using assms
  by (auto simp: closed_segment_eq_real_ivl intro!: integrable_continuous_real continuous_intros
    flow_continuous_on_intro
    intro: in_existence_between_zeroI)

lemma existence_ivl_eq_domain:
  assumes iv_defined: "t0  T" "x0  X"
  assumes bnd: "tm tM t x. tm  T  tM  T  M. L. t  {tm .. tM}. x  X. norm (f t x)  M + L * norm x"
  assumes "is_interval T" "X = UNIV"
  shows "existence_ivl t0 x0 = T"
proof -
  from assms have XI: "x  X" for x by auto
  {
    fix tm tM assume tm: "tm  T" and tM: "tM  T" and tmtM: "tm  t0" "t0  tM"
    from bnd[OF tm tM] obtain M' L'
    where bnd': "x t. x  X  tm  t  t  tM  norm (f t x)  M' + L' * norm x"
      by force
    define M where "M  norm M' + 1"
    define L where "L  norm L' + 1"
    have bnd: "x t. x  X  tm  t  t  tM  norm (f t x)  M + L * norm x"
      by (auto simp: M_def L_def intro!: bnd'[THEN order_trans] add_mono mult_mono)
    have "M > 0" "L > 0" by (auto simp: L_def M_def)

    let ?r = "(norm x0 + ¦tm - tM¦ * M + 1) * exp (L * ¦tm - tM¦)"
    define K where "K  cball (0::'a) ?r"
    have K: "compact K" "K  X"
      by (auto simp: K_def X = UNIV›)
    {
      fix t assume t: "t  existence_ivl t0 x0"  and le: "tm  t" "t  tM"
      {
        fix s assume sc: "s  closed_segment t0 t"
        then have s: "s  existence_ivl t0 x0" and le: "tm  s" "s  tM" using t le sc
          using closed_segment_subset_existence_ivl
          apply -
          subgoal by force
          subgoal by (metis (full_types) atLeastAtMost_iff closed_segment_eq_real_ivl order_trans tmtM(1))
          subgoal by (metis (full_types) atLeastAtMost_iff closed_segment_eq_real_ivl order_trans tmtM(2))
          done
        from sc have nle: "norm (t0 - s)  norm (t0 - t)" by (auto simp: closed_segment_eq_real_ivl split: if_split_asm)
        from flow_fixed_point[OF s]
        have "norm (flow t0 x0 s)  norm x0 + integral (closed_segment t0 s) (λt. M + L * norm (flow t0 x0 t))"
          using tmtM
          using closed_segment_subset_existence_ivl[OF s] le
          by (auto simp:
            intro!: norm_triangle_le norm_triangle_ineq4[THEN order.trans]
              ivl_integral_norm_bound_integral bnd
              integrable_continuous_closed_segment
              integrable_continuous_real
              continuous_intros
              continuous_on_subset[OF flow_continuous_on]
              flow_in_domain
              mem_existence_ivl_subset)
          (auto simp: closed_segment_eq_real_ivl split: if_splits)
        also have " = norm x0 + norm (t0 - s) * M + L * integral (closed_segment t0 s) (λt. norm (flow t0 x0 t))"
          by (simp add: integral_add integrable_on_simps s  existence_ivl _ _
            integral_const_closed_segment abs_minus_commute)
        also have "norm (t0 - s) * M  norm (t0 - t) * M "
          using nle M > 0 by auto
        also have "   + 1" by simp
        finally have "norm (flow t0 x0 s)  norm x0 + norm (t0 - t) * M + 1 +
            L * integral (closed_segment t0 s) (λt. norm (flow t0 x0 t))" by simp
      }
      then have "norm (flow t0 x0 t)  (norm x0 + norm (t0 - t) * M + 1) * exp (L * ¦t - t0¦)"
        using closed_segment_subset_existence_ivl[OF t]
        by (intro gronwall_more_general_segment[where a=t0 and b = t and t = t])
          (auto simp: 0 < L 0 < M less_imp_le
            intro!: add_nonneg_pos mult_nonneg_nonneg add_nonneg_nonneg continuous_intros
              flow_continuous_on_intro)
      also have "  ?r"
        using le tmtM
        by (auto simp: less_imp_le 0 < M 0 < L abs_minus_commute intro!: mult_mono)
      finally
      have "flow t0 x0 t  K" by (simp add: dist_norm K_def)
    } note flow_compact = this

    have "{tm..tM}  existence_ivl t0 x0"
      using tmtM tm x0  X ‹compact K K  X mem_is_intervalI[OF ‹is_interval T tm  T tM  T]
      by (intro subset_mem_compact_implies_subset_existence_interval[OF _ _ _ _flow_compact])
         (auto simp: tmtM is_interval_cc)
  } note bnds = this

  show "existence_ivl t0 x0 = T"
  proof safe
    fix x assume x: "x  T"
    from bnds[OF x iv_defined(1)] bnds[OF iv_defined(1) x]
    show "x  existence_ivl t0 x0"
      by (cases "x  t0") auto
  qed (insert existence_ivl_subset, fastforce)
qed

lemma flow_unique:
  assumes "t  existence_ivl t0 x0"
  assumes "phi t0 = x0"
  assumes "t. t  existence_ivl t0 x0  (phi has_vector_derivative f t (phi t)) (at t)"
  assumes "t. t  existence_ivl t0 x0  phi t  X"
  shows "flow t0 x0 t = phi t"
  apply (rule maximal_existence_flow[where K="existence_ivl t0 x0"])
  subgoal by (auto intro!: solves_odeI simp: has_vderiv_on_def assms at_within_open[OF _ open_existence_ivl])
  subgoal by fact
  subgoal by (simp add: )
  subgoal using mem_existence_ivl_iv_defined[OF t  existence_ivl t0 x0] by simp
  subgoal by (simp add: existence_ivl_subset)
  subgoal by fact
  done

lemma flow_unique_on:
  assumes "t  existence_ivl t0 x0"
  assumes "phi t0 = x0"
  assumes "(phi has_vderiv_on (λt. f t (phi t))) (existence_ivl t0 x0)"
  assumes "t. t  existence_ivl t0 x0  phi t  X"
  shows "flow t0 x0 t = phi t"
  using flow_unique[where phi=phi, OF assms(1,2) _ assms(4)] assms(3)
  by (auto simp: has_vderiv_on_open)

end ― ‹@{thm local_lipschitz}

locale two_ll_on_open =
  F: ll_on_open T1 F X + G: ll_on_open T2 G X
  for F T1 G T2 X J x0 +
  fixes e::real and K
  assumes t0_in_J: "0  J"
  assumes J_subset: "J  F.existence_ivl 0 x0"
  assumes J_ivl: "is_interval J"
  assumes F_lipschitz: "t. t  J  K-lipschitz_on X (F t)"
  assumes K_pos: "0 < K"
  assumes F_G_norm_ineq: "t x. t  J  x  X  norm (F t x - G t x) < e"
begin

context begin

lemma F_iv_defined: "0  T1" "x0  X"
  subgoal using F.existence_ivl_initial_time_iff J_subset t0_in_J by blast
  subgoal using F.mem_existence_ivl_iv_defined(2) J_subset t0_in_J by blast
  done

lemma e_pos: "0 < e"
  using le_less_trans[OF norm_ge_zero F_G_norm_ineq[OF t0_in_J F_iv_defined(2)]]
  by assumption

qualified definition "flow0 t = F.flow 0 x0 t"
qualified definition "Y t = G.flow 0 x0 t"

lemma norm_X_Y_bound:
shows "t  J  G.existence_ivl 0 x0. norm (flow0 t - Y t)  e / K * (exp(K * ¦t¦) - 1)"
proof(safe)
  fix t assume "t  J"
  assume tG: "t  G.existence_ivl 0 x0"
  have "0  J" by (simp add: t0_in_J)

  let ?u="λt. norm (flow0 t - Y t)"
  show "norm (flow0 t - Y t)  e / K * (exp (K * ¦t¦) - 1)"
  proof(cases "0  t")
    assume "0  t"
    hence [simp]: "¦t¦ = t" by simp

    have t0_t_in_J: "{0..t}  J"
      using t  J 0  J J_ivl
      using mem_is_interval_1_I atLeastAtMost_iff subsetI by blast

    note F_G_flow_cont[continuous_intros] =
      continuous_on_subset[OF F.flow_continuous_on]
      continuous_on_subset[OF G.flow_continuous_on]

    have "?u t + e/K  e/K * exp(K * t)"
    proof(rule gronwall[where g="λt. ?u t + e/K", OF _ _ _ _ K_pos 0  t order.refl])
      fix s assume "0  s" "s  t"
      hence "{0..s}  J" using t0_t_in_J by auto

      hence t0_s_in_existence:
        "{0..s}  F.existence_ivl 0 x0"
        "{0..s}  G.existence_ivl 0 x0"
        using J_subset tG 0  s s  t G.ivl_subset_existence_ivl[OF tG]
        by auto

      hence s_in_existence:
        "s  F.existence_ivl 0 x0"
        "s  G.existence_ivl 0 x0"
          using 0  s by auto

      note cont_statements[continuous_intros] =
        F_iv_defined (*  G.iv_defined *)
        F.flow_in_domain
        G.flow_in_domain
        F.mem_existence_ivl_subset
        G.mem_existence_ivl_subset

      have [integrable_on_simps]:
        "continuous_on {0..s} (λs. F s (F.flow 0 x0 s))"
        "continuous_on {0..s} (λs. G s (G.flow 0 x0 s))"
        "continuous_on {0..s} (λs. F s (G.flow 0 x0 s))"
        "continuous_on {0..s} (λs. G s (F.flow 0 x0 s))"
        using t0_s_in_existence
        by (auto intro!: continuous_intros integrable_continuous_real)

      have "flow0 s - Y s = integral {0..s} (λs. F s (flow0 s) - G s (Y s))"
        using 0  s
        by (simp add: flow0_def Y_def Henstock_Kurzweil_Integration.integral_diff integrable_on_simps ivl_integral_def
               F.flow_fixed_point[OF s_in_existence(1)]
               G.flow_fixed_point[OF s_in_existence(2)])
      also have "... = integral {0..s} (λs. (F s (flow0 s) - F s (Y s)) + (F s (Y s) - G s (Y s)))"
        by simp
      also have "... = integral {0..s} (λs. F s (flow0 s) - F s (Y s)) + integral {0..s} (λs. F s (Y s) - G s (Y s))"
        by (simp add: Henstock_Kurzweil_Integration.integral_diff Henstock_Kurzweil_Integration.integral_add flow0_def Y_def integrable_on_simps)
      finally have "?u s  norm (integral {0..s} (λs. F s (flow0 s) - F s (Y s))) + norm (integral {0..s} (λs. F s (Y s) - G s (Y s)))"
        by (simp add: norm_triangle_ineq)
      also have "...  integral {0..s} (λs. norm (F s (flow0 s) - F s (Y s))) + integral {0..s} (λs. norm (F s (Y s) - G s (Y s)))"
        using t0_s_in_existence
        by (auto simp add: flow0_def Y_def
          intro!: add_mono continuous_intros continuous_on_imp_absolutely_integrable_on)
      also have "...  integral {0..s} (λs. K * ?u s) + integral {0..s} (λs. e)"
      proof (rule add_mono[OF integral_le integral_le])
        show "norm (F x (flow0 x) - F x (Y x))  K * norm (flow0 x - Y x)" if "x  {0..s}" for x
          using F_lipschitz[unfolded lipschitz_on_def, THEN conjunct2] that
            cont_statements(1,2,4)
            t0_s_in_existence F_iv_defined (* G.iv_defined *)
          by (metis F_lipschitz flow0_def Y_def {0..s}  J lipschitz_on_normD F.flow_in_domain
            G.flow_in_domain subsetCE)
        show "x. x  {0..s}  norm (F x (Y x) - G x (Y x))  e"
          using F_G_norm_ineq cont_statements(2,3) t0_s_in_existence
          using Y_def {0..s}  J cont_statements(5) subset_iff G.flow_in_domain
          by (metis eucl_less_le_not_le)
      qed (simp_all add: t0_s_in_existence continuous_intros integrable_on_simps flow0_def Y_def)
      also have "... = K * integral {0..s} (λs. ?u s + e / K)"
        using K_pos t0_s_in_existence
        by (simp_all add: algebra_simps Henstock_Kurzweil_Integration.integral_add flow0_def Y_def continuous_intros
          continuous_on_imp_absolutely_integrable_on)
      finally show "?u s + e / K  e / K + K * integral {0..s} (λs. ?u s + e / K)"
        by simp
    next
      show "continuous_on {0..t} (λt. norm (flow0 t - Y t) + e / K)"
        using t0_t_in_J J_subset G.ivl_subset_existence_ivl[OF tG]
        by (auto simp add: flow0_def Y_def intro!: continuous_intros)
    next
      fix s assume "0  s" "s  t"
      show "0  norm (flow0 s - Y s) + e / K"
        using e_pos K_pos by simp
    next
      show "0 < e / K" using e_pos K_pos by simp
    qed
    thus ?thesis by (simp add: algebra_simps)
  next
    assume "¬0  t"
    hence "t  0" by simp
    hence [simp]: "¦t¦ = -t" by simp

    have t0_t_in_J: "{t..0}  J"
      using t  J 0  J J_ivl ¬ 0  t atMostAtLeast_subset_convex is_interval_convex_1
      by auto

    note F_G_flow_cont[continuous_intros] =
      continuous_on_subset[OF F.flow_continuous_on]
      continuous_on_subset[OF G.flow_continuous_on]

    have "?u t + e/K  e/K * exp(- K * t)"
    proof(rule gronwall_left[where g="λt. ?u t + e/K", OF _ _ _ _ K_pos order.refl t  0])
      fix s assume "t  s" "s  0"
      hence "{s..0}  J" using t0_t_in_J by auto

      hence t0_s_in_existence:
        "{s..0}  F.existence_ivl 0 x0"
        "{s..0}  G.existence_ivl 0 x0"
        using J_subset G.ivl_subset_existence_ivl'[OF tG] s  0 t  s
        by auto

      hence s_in_existence:
        "s  F.existence_ivl 0 x0"
        "s  G.existence_ivl 0 x0"
          using s  0 by auto

      note cont_statements[continuous_intros] =
        F_iv_defined
        F.flow_in_domain
        G.flow_in_domain
        F.mem_existence_ivl_subset
        G.mem_existence_ivl_subset
      then have [continuous_intros]:
        "{s..0}  T1"
        "{s..0}  T2"
        "F.flow 0 x0 ` {s..0}  X"
        "G.flow 0 x0 ` {s..0}  X"
        "s  x  x  0  x  F.existence_ivl 0 x0"
        "s  x  x  0  x  G.existence_ivl 0 x0" for x
        using t0_s_in_existence
        by (auto simp: )
      have "flow0 s - Y s = - integral {s..0} (λs. F s (flow0 s) - G s (Y s))"
        using t0_s_in_existence s  0
        by (simp add: flow0_def Y_def ivl_integral_def
               F.flow_fixed_point[OF s_in_existence(1)]
               G.flow_fixed_point[OF s_in_existence(2)]
               continuous_intros integrable_on_simps Henstock_Kurzweil_Integration.integral_diff)
      also have "... = - integral {s..0} (λs. (F s (flow0 s) - F s (Y s)) + (F s (Y s) - G s (Y s)))"
        by simp
      also have "... = - (integral {s..0} (λs. F s (flow0 s) - F s (Y s)) + integral {s..0} (λs. F s (Y s) - G s (Y s)))"
        using t0_s_in_existence
        by (subst Henstock_Kurzweil_Integration.integral_add) (simp_all add: integral_add flow0_def Y_def continuous_intros integrable_on_simps)
      finally have "?u s  norm (integral {s..0} (λs. F s (flow0 s) - F s (Y s))) + norm (integral {s..0} (λs. F s (Y s) - G s (Y s)))"
        by (metis (no_types, lifting) norm_minus_cancel norm_triangle_ineq)
      also have "...  integral {s..0} (λs. norm (F s (flow0 s) - F s (Y s))) + integral {s..0} (λs. norm (F s (Y s) - G s (Y s)))"
        using t0_s_in_existence
        by (auto simp add: flow0_def Y_def intro!: continuous_intros continuous_on_imp_absolutely_integrable_on add_mono)
      also have "...  integral {s..0} (λs. K * ?u s) + integral {s..0} (λs. e)"
      proof (rule add_mono[OF integral_le integral_le])
        show "norm (F x (flow0 x) - F x (Y x))  K * norm (flow0 x - Y x)" if "x{s..0}" for x
          using F_lipschitz[unfolded lipschitz_on_def, THEN conjunct2]
            cont_statements(1,2,4) that
            t0_s_in_existence F_iv_defined (* G.iv_defined *)
          by (metis F_lipschitz flow0_def Y_def {s..0}  J lipschitz_on_normD F.flow_in_domain
            G.flow_in_domain subsetCE)
        show "x. x  {s..0}  norm (F x (Y x) - G x (Y x))  e"
          using F_G_norm_ineq Y_def {s..0}  J cont_statements(5) subset_iff t0_s_in_existence(2)
          using Y_def {s..0}  J cont_statements(5) subset_iff G.flow_in_domain
          by (metis eucl_less_le_not_le)
      qed (simp_all add: t0_s_in_existence continuous_intros integrable_on_simps flow0_def Y_def)
      also have "... = K * integral {s..0} (λs. ?u s + e / K)"
        using K_pos t0_s_in_existence
        by (simp_all add: algebra_simps Henstock_Kurzweil_Integration.integral_add t0_s_in_existence continuous_intros integrable_on_simps flow0_def Y_def)
      finally show "?u s + e / K  e / K + K * integral {s..0} (λs. ?u s + e / K)"
        by simp
    next
      show "continuous_on {t..0} (λt. norm (flow0 t - Y t) + e / K)"
        using t0_t_in_J J_subset G.ivl_subset_existence_ivl'[OF tG] F_iv_defined
        by (auto simp add: flow0_def Y_def intro!: continuous_intros)
    next
      fix s assume "t  s" "s  0"
      show "0  norm (flow0 s - Y s) + e / K"
        using e_pos K_pos by simp
    next
      show "0 < e / K" using e_pos K_pos by simp
    qed
    thus ?thesis by (simp add: algebra_simps)
  qed
qed

end

end

locale auto_ll_on_open =
  fixes f::"'a::{banach, heine_borel}  'a" and X
  assumes auto_local_lipschitz: "local_lipschitz UNIV X (λ_::real. f)"
  assumes auto_open_domain[intro!, simp]: "open X"
begin

text ‹autonomous flow and existence interval ›

definition "flow0 x0 t = ll_on_open.flow UNIV (λ_. f) X 0 x0 t"

definition "existence_ivl0 x0 = ll_on_open.existence_ivl UNIV (λ_. f) X 0 x0"

sublocale ll_on_open_it UNIV "λ_. f" X 0
  rewrites "flow = (λt0 x0 t. flow0 x0 (t - t0))"
       and "existence_ivl = (λt0 x0. (+) t0 ` existence_ivl0 x0)"
       and "(+) 0 = (λx::real. x)"
       and "s - 0 = s"
       and "(λx. x) ` S = S"
       and "s  (+) t ` S  s - t  (S::real set)"
       and "P (s + t - s) = P (t::real)"― ‹TODO: why does just the equation not work?›
       and "P (t + s - s) = P t"― ‹TODO: why does just the equation not work?›
proof -
  interpret ll_on_open UNIV "λ_. f" X
    by unfold_locales (auto intro!: continuous_on_const auto_local_lipschitz)
  show "ll_on_open_it UNIV (λ_. f) X" ..
  show "(+) 0 = (λx::real. x)" "(λx. x) ` S = S" "s - 0 = s" "P (t + s - s) = P t" "P (s + t - s) = P (t::real)"
    by auto
  show "flow = (λt0 x0 t. flow0 x0 (t - t0))"
    unfolding flow0_def
    apply (rule ext)
    apply (rule ext)
    apply (rule flow_eq_in_existence_ivlI)
    apply (auto intro: flow_shift_autonomous1
       mem_existence_ivl_shift_autonomous1 mem_existence_ivl_shift_autonomous2)
    done
  show "existence_ivl = (λt0 x0. (+) t0 ` existence_ivl0 x0)"
    unfolding existence_ivl0_def
    apply (safe intro!: ext)
    subgoal using image_iff mem_existence_ivl_shift_autonomous1 by fastforce
    subgoal premises prems for t0 x0 x s
    proof -
      have f2: "x1 x2. (x2::real) - x1 = - 1 * x1 + x2"
        by auto
      have "- 1 * t0 + (t0 + s) = s"
        by auto
      then show ?thesis
        using f2 prems mem_existence_ivl_iv_defined(2) mem_existence_ivl_shift_autonomous2
        by presburger
    qed
    done
  show "(s  (+) t ` S) = (s - t  S)" by force
qed
― ‹at this point, there should be no theorems about existence_ivl›, only existence_ivl0›.
Moreover, (+) _ ` _› and _ + _ - _› etc should have been removed›

lemma existence_ivl_zero: "x0  X  0  existence_ivl0 x0" by simp

lemmas [continuous_intros del] = continuous_on_f
lemmas continuous_on_f_comp[continuous_intros] = continuous_on_f[OF continuous_on_const _ subset_UNIV]

lemma
  flow_in_compact_right_existence:
  assumes "t. 0  t  t  existence_ivl0 x  flow0 x t  K"
  assumes "compact K" "K  X"
  assumes "x  X" "t  0"
  shows "t  existence_ivl0 x"
proof (rule ccontr)
  assume "t  existence_ivl0 x"
  have "bdd_above (existence_ivl0 x)"
    by (rule bdd_above_is_intervalI[OF is_interval_existence_ivl 0  t existence_ivl_zero]) fact+
  from sup_existence_maximal[OF UNIV_I x  X assms(1-3) this]
  show False by auto
qed

lemma
  flow_in_compact_left_existence:
  assumes "t. t  0  t  existence_ivl0 x  flow0 x t  K"
  assumes "compact K" "K  X"
  assumes "x  X" "t  0"
  shows "t  existence_ivl0 x"
proof (rule ccontr)
  assume "t  existence_ivl0 x"
  have "bdd_below (existence_ivl0 x)"
    by (rule bdd_below_is_intervalI[OF is_interval_existence_ivl t  0 _ existence_ivl_zero]) fact+
  from inf_existence_minimal[OF UNIV_I x  X assms(1-3) this]
  show False by auto
qed

end

locale compact_continuously_diff =
  derivative_on_prod T X f "λ(t, x). f' x oL snd_blinfun"
    for T X and f::"real  'a::{banach,perfect_space,heine_borel}  'a"
    and f'::"'a  ('a, 'a) blinfun" +
  assumes compact_domain: "compact X"
  assumes convex: "convex X"
  assumes nonempty_domains: "T  {}" "X  {}"
  assumes continuous_derivative: "continuous_on X f'"
begin

lemma ex_onorm_bound:
  "B. x  X. norm (f' x)  B"
proof -
  from _ compact_domain have "compact (f' ` X)"
    by (intro compact_continuous_image continuous_derivative)
  hence "bounded (f' ` X)" by (rule compact_imp_bounded)
  thus ?thesis
    by (auto simp add: bounded_iff cball_def norm_blinfun.rep_eq)
qed

definition "onorm_bound = (SOME B. x  X. norm (f' x)  B)"

lemma onorm_bound: assumes "x  X" shows "norm (f' x)  onorm_bound"
  unfolding onorm_bound_def
  using someI_ex[OF ex_onorm_bound] assms
  by blast

sublocale closed_domain X
  using compact_domain by unfold_locales (rule compact_imp_closed)

sublocale global_lipschitz T X f onorm_bound
proof (unfold_locales, rule lipschitz_onI)
  fix t z y
  assume "t  T" "y  X" "z  X"
  then have "norm (f t y - f t z)  onorm_bound * norm (y - z)"
    using onorm_bound
    by (intro differentiable_bound[where f'=f', OF convex])
       (auto intro!: derivative_eq_intros simp: norm_blinfun.rep_eq)
  thus "dist (f t y) (f t z)  onorm_bound * dist y z"
    by (auto simp: dist_norm norm_Pair)
next
  from nonempty_domains obtain x where x: "x  X" by auto
  show "0  onorm_bound"
    using dual_order.trans local.onorm_bound norm_ge_zero x by blast
qed

end ― ‹@{thm compact_domain}

locale unique_on_compact_continuously_diff = self_mapping +
  compact_interval T +
  compact_continuously_diff T X f
begin

sublocale unique_on_closed t0 T x0 f X onorm_bound
  by unfold_locales (auto intro!: f' has_derivative_continuous_on)

end

locale c1_on_open =
  fixes f::"'a::{banach, perfect_space, heine_borel}  'a" and f' X
  assumes open_dom[simp]: "open X"
  assumes derivative_rhs:
    "x. x  X  (f has_derivative blinfun_apply (f' x)) (at x)"
  assumes continuous_derivative: "continuous_on X f'"
begin

lemmas continuous_derivative_comp[continuous_intros] =
  continuous_on_compose2[OF continuous_derivative]

lemma derivative_tendsto[tendsto_intros]:
  assumes [tendsto_intros]: "(g  l) F"
    and "l  X"
  shows "((λx. f' (g x))  f' l) F"
  using continuous_derivative[simplified continuous_on] assms
  by (auto simp: at_within_open[OF _ open_dom]
    intro!: tendsto_eq_intros
    intro: tendsto_compose)

lemma c1_on_open_rev[intro, simp]: "c1_on_open (-f) (-f') X"
  using derivative_rhs continuous_derivative
  by unfold_locales
    (auto intro!: continuous_intros derivative_eq_intros
    simp: fun_Compl_def blinfun.bilinear_simps)

lemma derivative_rhs_compose[derivative_intros]:
  "((g has_derivative g') (at x within s))  g x  X 
    ((λx. f (g x)) has_derivative
      (λxa. blinfun_apply (f' (g x)) (g' xa)))
    (at x within s)"
  by (metis has_derivative_compose[of g g' x s f "f' (g x)"] derivative_rhs)

sublocale auto_ll_on_open
proof (standard, rule local_lipschitzI)
  fix x and t::real
  assume "x  X"
  with open_contains_cball[of "UNIV::real set"] open_UNIV
    open_contains_cball[of X] open_dom
  obtain u v where uv: "cball t u  UNIV" "cball x v  X" "u > 0" "v > 0"
    by blast
  let ?T = "cball t u" and ?X = "cball x v"
  have "bounded ?X" by simp
  have "compact (cball x v)"
    by simp
  interpret compact_continuously_diff ?T ?X "λ_. f" f'
    using uv
    by unfold_locales
      (auto simp: convex_cball cball_eq_empty split_beta'
        intro!: derivative_eq_intros continuous_on_compose2[OF continuous_derivative]
          continuous_intros)
  have "onorm_bound-lipschitz_on ?X f"
    using lipschitz[of t] uv
    by auto
  thus "u>0. L. t  cball t u  UNIV. L-lipschitz_on (cball x u  X) f"
    by (intro exI[where x=v])
      (auto intro!: exI[where x=onorm_bound] 0 < v simp: Int_absorb2 uv)
qed (auto intro!: continuous_intros)

end ― ‹@{thm derivative_rhs}

locale c1_on_open_euclidean = c1_on_open f f' X
  for f::"'a::euclidean_space  _" and f' X
begin
lemma c1_on_open_euclidean_anchor: True ..

definition "vareq x0 t = f' (flow0 x0 t)"

interpretation var: ll_on_open "existence_ivl0 x0" "vareq x0" UNIV
  apply standard
  apply (auto intro!: c1_implies_local_lipschitz[where f' = "λ(t, x). vareq x0 t"] continuous_intros
      derivative_eq_intros
      simp: split_beta' blinfun.bilinear_simps vareq_def)
  using local.mem_existence_ivl_iv_defined(2) apply blast
  using local.existence_ivl_reverse local.mem_existence_ivl_iv_defined(2) apply blast
  using local.mem_existence_ivl_iv_defined(2) apply blast
  using local.existence_ivl_reverse local.mem_existence_ivl_iv_defined(2) apply blast
  done

context begin

lemma continuous_on_A[continuous_intros]:
  assumes "continuous_on S a"
  assumes "continuous_on S b"
  assumes "s. s  S  a s  X"
  assumes "s. s  S  b s  existence_ivl0 (a s)"
  shows "continuous_on S (λs. vareq (a s) (b s))"
proof -
  have "continuous_on S (λx. f' (flow0 (a x) (b x)))"
    by (auto intro!: continuous_intros assms flow_in_domain)
  then show ?thesis
    by (rule continuous_on_eq) (auto simp: assms vareq_def)
qed

lemmas [intro] = mem_existence_ivl_iv_defined

context
  fixes x0::'a
begin

lemma flow0_defined: "xa  existence_ivl0 x0  flow0 x0 xa  X"
  by (auto simp: flow_in_domain)

lemma continuous_on_flow0: "continuous_on (existence_ivl0 x0) (flow0 x0)"
  by (auto simp: intro!: continuous_intros)

lemmas continuous_on_flow0_comp[continuous_intros] = continuous_on_compose2[OF continuous_on_flow0]

lemma varexivl_eq_exivl:
  assumes "t  existence_ivl0 x0"
  shows "var.existence_ivl x0 t a = existence_ivl0 x0"
proof (rule var.existence_ivl_eq_domain)
  fix s t x
  assume s: "s  existence_ivl0 x0" and t: "t  existence_ivl0 x0"
  then have "{s .. t}  existence_ivl0 x0"
    by (metis atLeastatMost_empty_iff2 empty_subsetI real_Icc_closed_segment var.closed_segment_subset_domain)
  then have "continuous_on {s .. t} (vareq x0)"
    by (auto simp: closed_segment_eq_real_ivl intro!: continuous_intros flow0_defined)
  then have "compact ((vareq x0) ` {s .. t})"
    using compact_Icc
    by (rule compact_continuous_image)
  then obtain B where B: "u. u  {s .. t}  norm (vareq x0 u)  B"
    by (force dest!: compact_imp_bounded simp: bounded_iff)
  show "M L. t{s..t}. xUNIV. norm (blinfun_apply (vareq x0 t) x)  M + L * norm x"
    by (rule exI[where x=0], rule exI[where x=B])
      (auto intro!: order_trans[OF norm_blinfun] mult_right_mono B simp:)
qed (auto intro: assms)

definition "vector_Dflow u0 t  var.flow x0 0 u0 t"

qualified abbreviation "Y z t  flow0 (x0 + z) t"

text ‹Linearity of the solution to the variational equation.
  TODO: generalize this and some other things for arbitrary linear ODEs›
lemma vector_Dflow_linear:
assumes "t  existence_ivl0 x0"
shows "vector_Dflow (α *R a + β *R b) t = α *R vector_Dflow a t + β *R vector_Dflow b t"
proof -
  note mem_existence_ivl_iv_defined[OF assms, intro, simp]
  have "((λc. α *R var.flow x0 0 a c + β *R var.flow x0 0 b c) solves_ode (λx. vareq x0 x)) (existence_ivl0 x0) UNIV"
    by (auto intro!: derivative_intros var.flow_has_vector_derivative solves_odeI
      simp: blinfun.bilinear_simps varexivl_eq_exivl vareq_def[symmetric])
  moreover
  have "α *R var.flow x0 0 a 0 + β *R var.flow x0 0 b 0 = α *R a + β *R b" by simp
  moreover note is_interval_existence_ivl[of x0]
  ultimately show ?thesis
    unfolding vareq_def[symmetric] vector_Dflow_def
    by (rule var.maximal_existence_flow) (auto simp: assms)
qed

lemma linear_vector_Dflow:
assumes "t  existence_ivl0 x0"
shows "linear (λz. vector_Dflow z t)"
using vector_Dflow_linear[OF assms, of 1 _ 1] vector_Dflow_linear[OF assms, of _ _ 0]
by (auto intro!: linearI)

lemma bounded_linear_vector_Dflow:
assumes "t  existence_ivl0 x0"
shows "bounded_linear (λz. vector_Dflow z t)"
by (simp add: linear_linear linear_vector_Dflow assms)

lemma vector_Dflow_continuous_on_time: "x0  X  continuous_on (existence_ivl0 x0) (λt. vector_Dflow z t)"
  using var.flow_continuous_on[of x0 0 z] varexivl_eq_exivl
  unfolding vector_Dflow_def
  by (auto simp:  )

proposition proposition_17_6_weak:
  ― ‹from "Differential Equations, Dynamical Systems, and an Introduction to Chaos",
    Hirsch/Smale/Devaney›
assumes "t  existence_ivl0 x0"
shows "(λy. (Y (y - x0) t - flow0 x0 t - vector_Dflow (y - x0) t) /R norm (y - x0))  x0  0"
proof-
  note x0_def = mem_existence_ivl_iv_defined[OF assms]
  have "0  existence_ivl0 x0"
    by (simp add: x0_def)

  text ‹Find some J ⊆ existence_ivl0 x0› with 0 ∈ J› and t ∈ J›.›
  define t0 where "t0  min 0 t"
  define t1 where "t1  max 0 t"
  define J where "J  {t0..t1}"

  have "t0  0" "0  t1" "0  J" "J  {}" "t  J" "compact J"
  and J_in_existence: "J  existence_ivl0 x0"
    using ivl_subset_existence_ivl ivl_subset_existence_ivl' x0_def assms
    by (auto simp add: J_def t0_def t1_def min_def max_def)

  {
    fix z S
    assume assms: "x0 + z  X" "S  existence_ivl0 (x0 + z)"
    have "continuous_on S (Y z)"
      using flow_continuous_on assms(1)
      by (intro continuous_on_subset[OF _ assms(2)]) (simp add:)
  }
  note [continuous_intros] = this integrable_continuous_real blinfun.continuous_on

  have U_continuous[continuous_intros]: "z. continuous_on J (vector_Dflow z)"
    by(rule continuous_on_subset[OF vector_Dflow_continuous_on_time[OF x0  X] J_in_existence])

  from t  J
  have "t0  t"
  and "t  t1"
  and "t0  t1"
  and "t0  existence_ivl0 x0"
  and "t  existence_ivl0 x0"
  and "t1  existence_ivl0 x0"
    using J_def J_in_existence by auto
  from global_existence_ivl_explicit[OF t0  existence_ivl0 x0 t1  existence_ivl0 x0 t0  t1]
  obtain u K where uK_def:
    "0 < u"
    "0 < K"
    "ball x0 u  X"
    "y. y  ball x0 u  t0  existence_ivl0 y"
    "y. y  ball x0 u  t1  existence_ivl0 y"
    "t y. y  ball x0 u  t  J  dist (flow0 x0 t) (Y (y - x0) t)  dist x0 y * exp (K * ¦t¦)"
    by (auto simp add: J_def)

  have J_in_existence_ivl: "y. y  ball x0 u  J  existence_ivl0 y"
    unfolding J_def
    using uK_def
    by (simp add: real_Icc_closed_segment segment_subset_existence_ivl t0_def t1_def)
  have ball_in_X: "z. z  ball 0 u  x0 + z  X"
    using uK_def(3)
    by (auto simp: dist_norm)

  have flow0_J_props: "flow0 x0 ` J  {}" "compact (flow0 x0 ` J)" "flow0 x0` J  X"
    using t0  t1
    using J_def(1) J_in_existence
    by (auto simp add: J_def intro!:
      compact_continuous_image continuous_intros flow_in_domain)

  have [continuous_intros]: "continuous_on J (λs. f' (flow0 x0 s))"
    using J_in_existence
    by (auto intro!: continuous_intros flow_in_domain simp:)

  text ‹ Show the thesis via cases t = 0›, 0 < t› and t < 0›. ›
  show ?thesis
  proof(cases "t = 0")
    assume "t = 0"
    show ?thesis
    unfolding t = 0 Lim_at
    proof(simp add: dist_norm[of _ 0] del: zero_less_dist_iff, safe, rule exI, rule conjI[OF 0 < u], safe)
      fix e::real and x assume "0 < e" "0 < dist x x0" "dist x x0 < u"
      hence "x  X"
        using uK_def(3)
        by (auto simp: dist_commute)
      hence "inverse (norm (x - x0)) * norm (Y (x - x0) 0 - flow0 x0 0 - vector_Dflow (x - x0) 0) = 0"
        using x0_def
        by (simp add: vector_Dflow_def)
      thus "inverse (norm (x - x0)) * norm (flow0 x 0 - flow0 x0 0 - vector_Dflow (x - x0) 0) < e"
        using 0 < e by auto
    qed
  next
    assume "t  0"
    show ?thesis
    proof(unfold Lim_at, safe)
      fix e::real assume "0 < e"
      then obtain e' where "0 < e'" "e' < e"
        using dense by auto

      obtain N
        where N_ge_SupS: "Sup { norm (f' (flow0 x0 s)) |s. s  J }  N" (is "Sup ?S  N")
          and N_gr_0: "0 < N"
        ― ‹We need N to be an upper bound of @{term ?S}, but also larger than zero.›
        by (meson le_cases less_le_trans linordered_field_no_ub)
      have N_ineq: "s. s  J  norm (f' (flow0 x0 s))  N"
        proof-
          fix s assume "s  J"
          have "?S = (norm o f' o flow0 x0) ` J" by auto
          moreover have "continuous_on J (norm o f' o flow0 x0)"
            using J_in_existence
            by (auto intro!: continuous_intros)
          ultimately have  "a b. ?S = {a..b}  a  b"
            using continuous_image_closed_interval[OF t0  t1]
            by (simp add: J_def)
          then obtain a b where "?S = {a..b}" and "a  b" by auto
          hence "bdd_above ?S" by simp
          from s  J  cSup_upper[OF _ this]
          have "norm (f' (flow0 x0 s))  Sup ?S"
            by auto
          thus "norm (f' (flow0 x0 s))  N"
            using N_ge_SupS by simp
        qed

      text ‹ Define a small region around flow0 ` J›, that is a subset of the domain X›. ›
      from compact_in_open_separated[OF flow0_J_props(1,2) auto_open_domain flow0_J_props(3)]
        obtain e_domain where e_domain_def: "0 < e_domain" "{x. infdist x (flow0 x0 ` J)  e_domain}  X"
        by auto
      define G where "G  {xX. infdist x (flow0 x0 ` J) < e_domain}"
      have G_vimage: "G = ((λx. infdist x (flow0 x0 ` J)) -` {..<e_domain})  X"
        by (auto simp: G_def)
      have "open G" "G  X"
        unfolding G_vimage
        by (auto intro!: open_Int open_vimage continuous_intros continuous_at_imp_continuous_on)

      text ‹Define a compact subset H of G. Inside H, we can guarantee
         an upper bound on the Taylor remainder.›
      define e_domain2 where "e_domain2  e_domain / 2"
      have "e_domain2 > 0" "e_domain2 < e_domain" using e_domain > 0
        by (simp_all add: e_domain2_def)
      define H where "H  {x. infdist x (flow0 x0 ` J)  e_domain2}"
      have H_props: "H  {}" "compact H" "H  G"
        proof-
          have "x0  flow0 x0 ` J"
            unfolding image_iff
            using 0  J  x0_def
            by force

          hence "x0  H"
            using 0 < e_domain2
            by (simp add: H_def x0_def)
          thus "H  {}"
            by auto
        next
          show "compact H"
            unfolding H_def
            using 0 < e_domain2 flow0_J_props
            by (intro compact_infdist_le) simp_all
        next
          show "H  G"
          proof
            fix x assume "x  H"
            then have *: "infdist x (flow0 x0 ` J) < e_domain"
              using 0 < e_domain
              by (simp add: H_def e_domain2_def)
            then have "x  X"
              using e_domain_def(2)
              by auto
            with * show "x  G"
              unfolding G_def
              by auto
          qed
        qed

      have f'_cont_on_G: "(x. x  G  isCont f' x)"
        using continuous_on_interior[OF continuous_on_subset[OF continuous_derivative G  X]]
        by (simp add: interior_open[OF ‹open G])

      define e1 where "e1  e' / (¦t¦ * exp (K * ¦t¦) * exp (N * ¦t¦))"
        ― ‹@{term e1} is the bounding term for the Taylor remainder.›
      have "0 < ¦t¦"
        using t  0
        by simp
      hence "0 < e1"
        using 0 < e'
        by (simp add: e1_def)

      text ‹ Taylor expansion of f on set G. ›
      from uniform_explicit_remainder_Taylor_1[where f=f and f'=f',
        OF derivative_rhs[OF subsetD[OF G  X]] f'_cont_on_G ‹open G H_props 0 < e1]
      obtain d_Taylor R
      where Taylor_expansion:
        "0 < d_Taylor"
        "x z. f z = f x + (f' x) (z - x) + R x z"
        "x y. x  H  y  H  dist x y < d_Taylor  norm (R x y)  e1 * dist x y"
        "continuous_on (G × G) (λ(a, b). R a b)"
          by auto

      text ‹ Find d, such that solutions are always at least min (e_domain/2) d_Taylor› apart,
         i.e. always in H. This later gives us the bound on the remainder. ›
      have "0 < min (e_domain/2) d_Taylor"
        using 0 < d_Taylor 0 < e_domain
        by auto
      from uniform_limit_flow[OF t0  existence_ivl0 x0 t1  existence_ivl0 x0 t0  t1,
        THEN uniform_limitD, OF this, unfolded eventually_at]
      obtain d_ivl where d_ivl_def:
        "0 < d_ivl"
        "x. 0 < dist x x0  dist x x0 < d_ivl 
          (tJ. dist (flow0 x0 t) (Y (x - x0) t) < min (e_domain / 2) d_Taylor)"
        by (auto simp: dist_commute J_def)

      define d where "d  min u d_ivl"
      have "0 < d" using 0 < u 0 < d_ivl
        by (simp add: d_def)
      hence "d  u" "d  d_ivl"
        by (auto simp: d_def)

      text ‹ Therefore, any flow0 starting in ball x0 d› will be in G. ›
      have Y_in_G: "y. y  ball x0 d  (λs. Y (y - x0) s) ` J  G"
        proof
          fix x y assume assms: "y  ball x0 d" "x  (λs. Y (y - x0) s) ` J"
          show "x  G"
          proof(cases)
            assume "y = x0"
            from assms(2)
            have "x  flow0 x0 ` J"
              by (simp add: y = x0)
            thus "x  G"
              using 0 < e_domain ‹flow0 x0 ` J  X
              by (auto simp: G_def)
          next
            assume "y  x0"
            hence "0 < dist y x0"
              by (simp add: dist_norm)
            from d_ivl_def(2)[OF this] d  d_ivl  0 < e_domain assms(1)
            have dist_flow0_Y: "t. t  J  dist (flow0 x0 t) (Y (y - x0) t) < e_domain"
              by (auto simp: dist_commute)

            from assms(2)
            obtain t where t_def: "t  J" "x = Y (y - x0) t"
              by auto
            have "x  X"
              unfolding t_def(2)
              using uK_def(3) assms(1) d  u subsetD[OF J_in_existence_ivl t_def(1)]
              by (auto simp: intro!: flow_in_domain)

            have "flow0 x0 t  flow0 x0 ` J" using t_def by auto
            from dist_flow0_Y[OF t_def(1)]
            have "dist x (flow0 x0 t) < e_domain"
              by (simp add: t_def(2) dist_commute)
            from le_less_trans[OF infdist_le[OF ‹flow0 x0 t  flow0 x0 ` J] this] x  X
            show "x  G"
              by (auto simp: G_def)
          qed
        qed
      from this[of x0] 0 < d
      have X_in_G: "flow0 x0 ` J  G"
        by (simp add: )

      show "d>0. x. 0 < dist x x0  dist x x0 < d 
                     dist ((Y (x - x0) t - flow0 x0 t - vector_Dflow (x - x0) t) /R norm (x - x0)) 0 < e"
      proof(rule exI, rule conjI[OF 0 < d], safe, unfold norm_conv_dist[symmetric])
        fix x assume x_x0_dist: "0 < dist x x0" "dist x x0 < d"
        hence x_in_ball': "x  ball x0 d"
          by (simp add: dist_commute)
        hence x_in_ball: "x  ball x0 u"
          using d  u
          by simp

        text ‹ First, some prerequisites. ›
        from x_in_ball
        have z_in_ball: "x - x0  ball 0 u"
          using 0 < u
          by (simp add: dist_norm)
        hence [continuous_intros]: "dist x0 x < u"
          by (auto simp: dist_norm)

        from J_in_existence_ivl[OF x_in_ball]
        have J_in_existence_ivl_x: "J  existence_ivl0 x" .
        from ball_in_X[OF z_in_ball]
        have x_in_X[continuous_intros]: "x  X"
          by simp

        text ‹ On all of J›, we can find upper bounds for the distance of flow0› and Y›. ›
        have dist_flow0_Y: "s. s  J  dist (flow0 x0 s) (Y (x - x0) s)  dist x0 x * exp (K * ¦t¦)"
          using t0_def t1_def uK_def(2)
          by (intro order_trans[OF uK_def(6)[OF x_in_ball] mult_left_mono])
             (auto simp add: J_def intro!: mult_mono)
        from d_ivl_def x_x0_dist d  d_ivl
        have dist_flow0_Y2: "t. t  J  dist (flow0 x0 t) (Y (x - x0) t) < min (e_domain2) d_Taylor"
          by (auto simp: e_domain2_def)

        let ?g = "λt. norm (Y (x - x0) t - flow0 x0 t - vector_Dflow (x - x0) t)"
        let ?C = "¦t¦ * dist x0 x * exp (K * ¦t¦) * e1"
        text ‹ Find an upper bound to ?g›, i.e. show that
             ?g s ≤ ?C + N * integral {a..b} ?g›
           for {a..b} = {0..s}› or {a..b} = {s..0}› for some s ∈ J›.
           We can then apply Grönwall's inequality to obtain a true bound for ?g›. ›
        have g_bound: "?g s  ?C + N * integral {a..b} ?g"
          if s_def: "s  {a..b}"
          and J'_def: "{a..b}  J"
          and ab_cases: "(a = 0  b = s)  (a = s  b = 0)"
          for s a b
        proof -
          from that have "s  J" by auto

          have s_in_existence_ivl_x0: "s  existence_ivl0 x0"
            using J_in_existence s  J by auto
          have s_in_existence_ivl: "y. y  ball x0 u  s  existence_ivl0 y"
            using J_in_existence_ivl s  J by auto
          have s_in_existence_ivl2: "z. z  ball 0 u  s  existence_ivl0 (x0 + z)"
            using s_in_existence_ivl
            by (simp add: dist_norm)

          text ‹Prove continuities beforehand.›
          note continuous_on_0_s[continuous_intros] = continuous_on_subset[OF _ {a..b}  J]

          have[continuous_intros]: "continuous_on J (flow0 x0)"
            using J_in_existence
            by (auto intro!: continuous_intros simp:)
          {
            fix z S
            assume assms: "x0 + z  X" "S  existence_ivl0 (x0 + z)"
            have "continuous_on S (λs. f (Y z s))"
            proof(rule continuous_on_subset[OF _ assms(2)])
              show "continuous_on (existence_ivl0 (x0 + z)) (λs. f (Y z s))"
                using assms
                by (auto intro!: continuous_intros flow_in_domain flow_continuous_on simp:)
            qed
          }
          note [continuous_intros] = this

          have [continuous_intros]: "continuous_on J (λs. f (flow0 x0 s))"
            by(rule continuous_on_subset[OF _ J_in_existence])
              (auto intro!: continuous_intros flow_continuous_on flow_in_domain simp: x0_def)

          have [continuous_intros]: "z. continuous_on J (λs. f' (flow0 x0 s) (vector_Dflow z s))"
          proof-
            fix z
            have a1: "continuous_on J (flow0 x0)"
              by (auto intro!: continuous_intros)

            have a2: "(λs. (flow0 x0 s, vector_Dflow z s)) ` J  (flow0 x0 ` J) × ((λs. vector_Dflow z s) ` J)"
              by auto
            have a3: "continuous_on ((λs. (flow0 x0 s, vector_Dflow z s)) ` J) (λ(x, u). f' x u)"
              using assms flow0_J_props
              by (auto intro!: continuous_intros simp: split_beta')
            from continuous_on_compose[OF continuous_on_Pair[OF a1 U_continuous] a3]
            show "continuous_on J (λs. f' (flow0 x0 s) (vector_Dflow z s))"
              by simp
          qed

          have [continuous_intros]: "continuous_on J (λs. R (flow0 x0 s) (Y (x - x0) s))"
            using J_in_existence J_in_existence_ivl[OF x_in_ball] X_in_G {a..b}  J Y_in_G
              x_x0_dist
            by (auto intro!: continuous_intros continuous_on_compose_Pair[OF Taylor_expansion(4)]
              simp: dist_commute subset_iff)
          hence [continuous_intros]:
            "(λs. R (flow0 x0 s) (Y (x - x0) s)) integrable_on J"
            unfolding J_def
            by (rule integrable_continuous_real)

          have i1: "integral {a..b} (λs. f (flow0 x s)) - integral {a..b} (λs. f (flow0 x0 s)) =
              integral {a..b} (λs. f (flow0 x s) - f (flow0 x0 s))"
            using J_in_existence_ivl[OF x_in_ball]
            apply (intro Henstock_Kurzweil_Integration.integral_diff[symmetric])
             by (auto intro!: continuous_intros existence_ivl_reverse)
          have i2:
            "integral {a..b} (λs. f (flow0 x s) - f (flow0 x0 s) - (f' (flow0 x0 s)) (vector_Dflow (x - x0) s)) =
              integral {a..b} (λs. f (flow0 x s) - f (flow0 x0 s)) -
              integral {a..b} (λs. f' (flow0 x0 s) (vector_Dflow (x - x0) s))"
            using J_in_existence_ivl[OF x_in_ball]
            by (intro Henstock_Kurzweil_Integration.integral_diff[OF Henstock_Kurzweil_Integration.integrable_diff])
              (auto intro!: continuous_intros existence_ivl_reverse)
          from ab_cases
          have "?g s = norm (integral {a..b} (λs'. f (Y (x - x0) s')) -
            integral {a..b} (λs'. f (flow0 x0 s')) -
            integral {a..b} (λs'. (f' (flow0 x0 s')) (vector_Dflow (x - x0) s')))"
          proof(safe)
            assume "a = 0" "b = s"
            hence "0  s" using s  {a..b} by simp

            text‹ Integral equations for flow0, Y and U. ›
            have flow0_integral_eq: "flow0 x0 s = x0 + ivl_integral 0 s (λs. f (flow0 x0 s))"
              by (rule flow_fixed_point[OF s_in_existence_ivl_x0])
            have Y_integral_eq: "flow0 x s = x0 + (x - x0) + ivl_integral 0 s (λs. f (Y (x - x0) s))"
              using flow_fixed_point 0  s s_in_existence_ivl2[OF z_in_ball] ball_in_X[OF z_in_ball]
              by (simp add:)
            have U_integral_eq: "vector_Dflow (x - x0) s = (x - x0) + ivl_integral 0 s (λs. vareq x0 s (vector_Dflow (x - x0) s))"
              unfolding vector_Dflow_def
              by (rule var.flow_fixed_point)
                (auto simp: 0  s x0_def varexivl_eq_exivl s_in_existence_ivl_x0)
            show "?g s = norm (integral {0..s} (λs'. f (Y (x - x0) s')) -
                integral {0..s} (λs'. f (flow0 x0 s')) -
                integral {0..s} (λs'. blinfun_apply (f' (flow0 x0 s')) (vector_Dflow (x - x0) s')))"
              using 0  s
              unfolding vareq_def[symmetric]
              by (simp add: flow0_integral_eq Y_integral_eq U_integral_eq ivl_integral_def)
          next
            assume "a = s" "b = 0"
            hence "s  0" using s  {a..b} by simp

            have flow0_integral_eq_left: "flow0 x0 s = x0 + ivl_integral 0 s (λs. f (flow0 x0 s))"
              by (rule flow_fixed_point[OF s_in_existence_ivl_x0])
            have Y_integral_eq_left: "Y (x - x0) s = x0 + (x - x0) + ivl_integral 0 s (λs. f (Y (x - x0) s))"
              using flow_fixed_point s  0 s_in_existence_ivl2[OF z_in_ball] ball_in_X[OF z_in_ball]
              by (simp add: )
            have U_integral_eq_left: "vector_Dflow (x - x0) s = (x - x0) + ivl_integral 0 s (λs. vareq x0 s (vector_Dflow (x - x0) s))"
              unfolding vector_Dflow_def
              by (rule var.flow_fixed_point)
                (auto simp: s  0 x0_def varexivl_eq_exivl s_in_existence_ivl_x0)

            have "?g s =
              norm (- integral {s..0} (λs'. f (Y (x - x0) s')) +
                integral {s..0} (λs'. f (flow0 x0 s')) +
                integral {s..0} (λs'. vareq x0 s' (vector_Dflow (x - x0) s')))"
              unfolding flow0_integral_eq_left Y_integral_eq_left U_integral_eq_left
              using s  0
              by (simp add: ivl_integral_def)
            also have "... = norm (integral {s..0} (λs'. f (Y (x - x0) s')) -
                integral {s..0} (λs'. f (flow0 x0 s')) -
                integral {s..0} (λs'. vareq x0 s' (vector_Dflow (x - x0) s')))"
              by (subst norm_minus_cancel[symmetric], simp)
            finally show "?g s =
              norm (integral {s..0} (λs'. f (Y (x - x0) s')) -
                integral {s..0} (λs'. f (flow0 x0 s')) -
                integral {s..0} (λs'. blinfun_apply (f' (flow0 x0 s')) (vector_Dflow (x - x0) s')))"
              unfolding vareq_def .
          qed
          also have "... =
            norm (integral {a..b} (λs. f (Y (x - x0) s) - f (flow0 x0 s) - (f' (flow0 x0 s)) (vector_Dflow (x - x0) s)))"
            by (simp add: i1 i2)
          also have "... 
            integral {a..b} (λs. norm (f (Y (x - x0) s) - f (flow0 x0 s) - f' (flow0 x0 s) (vector_Dflow (x - x0) s)))"
            using x_in_X J_in_existence_ivl_x J_in_existence {a..b}  J
            by (auto intro!: continuous_intros continuous_on_imp_absolutely_integrable_on
                existence_ivl_reverse)
          also have "... = integral {a..b}
              (λs. norm (f' (flow0 x0 s) (Y (x - x0) s - flow0 x0 s - vector_Dflow (x - x0) s) + R (flow0 x0 s) (Y (x - x0) s)))"
          proof (safe intro!: integral_spike[OF negligible_empty, simplified] arg_cong[where f=norm])
            fix s' assume "s'  {a..b}"
            show "f' (flow0 x0 s') (Y (x - x0) s' - flow0 x0 s' - vector_Dflow (x - x0) s') + R (flow0 x0 s') (Y (x - x0) s') =
              f (Y (x - x0) s') - f (flow0 x0 s') - f' (flow0 x0 s') (vector_Dflow (x - x0) s')"
              by (simp add: blinfun.diff_right Taylor_expansion(2)[of "flow0 x s'" "flow0 x0 s'"])
          qed
          also have "...  integral {a..b}
            (λs. norm (f' (flow0 x0 s) (Y (x - x0) s - flow0 x0 s - vector_Dflow (x - x0) s)) +
              norm (R (flow0 x0 s) (Y (x - x0) s)))"
            using J_in_existence_ivl[OF x_in_ball] norm_triangle_ineq
            using ‹continuous_on J (λs. R (flow0 x0 s) (Y (x - x0) s))
            by (auto intro!: continuous_intros integral_le)
          also have "... =
            integral {a..b} (λs. norm (f' (flow0 x0 s) (Y (x - x0) s - flow0 x0 s - vector_Dflow (x - x0) s))) +
            integral {a..b} (λs. norm (R (flow0 x0 s) (Y (x - x0) s)))"
            using J_in_existence_ivl[OF x_in_ball]
            using ‹continuous_on J (λs. R (flow0 x0 s) (Y (x - x0) s))
            by (auto intro!: continuous_intros Henstock_Kurzweil_Integration.integral_add)
          also have "...  N * integral {a..b} ?g + ?C" (is "?l1 + ?r1  _")
          proof(rule add_mono)
            have "?l1  integral {a..b} (λs. norm (f' (flow0 x0 s)) * norm (Y (x - x0) s - flow0 x0 s - vector_Dflow (x - x0) s))"
              using norm_blinfun J_in_existence_ivl[OF x_in_ball]
              by (auto intro!: continuous_intros integral_le)

            also have "...  integral {a..b} (λs. N * norm (Y (x - x0) s - flow0 x0 s - vector_Dflow (x - x0) s))"
              using J_in_existence_ivl[OF x_in_ball] N_ineq[OF {a..b}  J[THEN subsetD]]
              by (intro integral_le) (auto intro!: continuous_intros mult_right_mono)
              
            also have "... = N * integral {a..b} (λs. norm ((Y (x - x0) s - flow0 x0 s - vector_Dflow (x - x0) s)))"
              unfolding real_scaleR_def[symmetric]
              by(rule integral_cmul)
            finally show "?l1  N * integral {a..b} ?g" .
          next
            have "?r1  integral {a..b} (λs. e1 * dist (flow0 x0 s) (Y (x - x0) s))"
              using J_in_existence_ivl[OF x_in_ball] 0 < e_domain dist_flow0_Y2 0 < e_domain2
              by (intro integral_le)
                (force
                  intro!: continuous_intros Taylor_expansion(3) order_trans[OF infdist_le]
                   dest!: {a..b}  J[THEN subsetD]
                   intro: less_imp_le
                   simp: dist_commute H_def)+
            also have "...  integral {a..b} (λs. e1 * (dist x0 x * exp (K * ¦t¦)))"
              apply(rule integral_le)
              subgoal using J_in_existence_ivl[OF x_in_ball] by (force intro!: continuous_intros)
              subgoal by force
              subgoal by (force dest!: {a..b}  J[THEN subsetD]
                intro!: less_imp_le[OF 0 < e1] mult_left_mono[OF dist_flow0_Y])
              done
            also have "...  ?C"
              using s  J x_x0_dist 0 < e1 {a..b}  J 0 < ¦t¦ t0_def t1_def
              by (auto simp: integral_const_real J_def(1))
            finally show "?r1  ?C" .
          qed
          finally show ?thesis
            by simp
        qed
        have g_continuous: "continuous_on J ?g"
          using J_in_existence_ivl[OF x_in_ball] J_in_existence
          using J_def(1) U_continuous
          by (auto simp: J_def intro!: continuous_intros)
        note [continuous_intros] = continuous_on_subset[OF g_continuous]
        have C_gr_zero: "0 < ?C"
          using 0 < ¦t¦ 0 < e1 x_x0_dist(1)
          by (simp add: dist_commute)
        have "0  t  t  0" by auto
        then have "?g t  ?C * exp (N * ¦t¦)"
        proof
          assume "0  t"
          moreover
          have "continuous_on {0..t} (vector_Dflow (x - x0))"
            using U_continuous
            by (rule continuous_on_subset) (auto simp: J_def t0_def t1_def)
          then have "norm (Y (x - x0) t - flow0 x0 t - vector_Dflow (x - x0) t) 
            ¦t¦ * dist x0 x * exp (K * ¦t¦) * e1 * exp (N * t)"
            using t  J J_def t0  0 J_in_existence J_in_existence_ivl_x
            by (intro gronwall[OF g_bound _ _ C_gr_zero 0 < N 0  t order.refl])
               (auto intro!: continuous_intros simp: )
          ultimately show ?thesis by simp
        next
          assume "t  0"
          moreover
          have "continuous_on {t .. 0} (vector_Dflow (x - x0))"
            using U_continuous
            by (rule continuous_on_subset) (auto simp: J_def t0_def t1_def)
          then have "norm (Y (x - x0) t - flow0 x0 t - vector_Dflow (x - x0) t) 
            ¦t¦ * dist x0 x * exp (K * ¦t¦) * e1 * exp (- N * t)"
            using t  J J_def 0  t1 J_in_existence J_in_existence_ivl_x
            by (intro gronwall_left[OF g_bound _ _ C_gr_zero 0 < N order.refl t  0])
                (auto intro!: continuous_intros)
          ultimately show ?thesis
            by simp
        qed
        also have "... = dist x x0 * (¦t¦ * exp (K * ¦t¦) * e1 * exp (N * ¦t¦))"
          by (auto simp: dist_commute)
        also have "... < norm (x - x0) * e"
          unfolding e1_def
          using e' < e 0 < ¦t¦ 0 < e1 x_x0_dist(1)
          by (simp add: dist_norm)
        finally show "norm ((Y (x - x0) t - flow0 x0 t - vector_Dflow (x - x0) t) /R norm (x - x0)) < e"
          by (simp, metis x_x0_dist(1) dist_norm divide_inverse mult.commute pos_divide_less_eq)
      qed
    qed
  qed
qed

lemma local_lipschitz_A:
  "OT  existence_ivl0 x0  local_lipschitz OT (OS::('a L 'a) set) (λt. (oL) (vareq x0 t))"
  by (rule local_lipschitz_subset[OF _ _ subset_UNIV, where T="existence_ivl0 x0"])
     (auto simp: split_beta' vareq_def
      intro!: c1_implies_local_lipschitz[where f'="λ(t, x). comp3 (f' (flow0 x0 t))"]
        derivative_eq_intros blinfun_eqI ext
        continuous_intros flow_in_domain)

lemma total_derivative_ll_on_open:
  "ll_on_open (existence_ivl0 x0) (λt. blinfun_compose (vareq x0 t)) (UNIV::('a L 'a) set)"
  by standard (auto intro!: continuous_intros local_lipschitz_A[OF order_refl])

end

end

sublocale mvar: ll_on_open "existence_ivl0 x0" "λt. blinfun_compose (vareq x0 t)" "UNIV::('a L 'a) set" for x0
  by (rule total_derivative_ll_on_open)

lemma mvar_existence_ivl_eq_existence_ivl[simp]:― ‹TODO: unify with @{thm varexivl_eq_exivl}
  assumes "t  existence_ivl0 x0"
  shows "mvar.existence_ivl x0 t = (λ_. existence_ivl0 x0)"
proof (rule ext, rule mvar.existence_ivl_eq_domain)
  fix s t x
  assume s: "s  existence_ivl0 x0" and t: "t  existence_ivl0 x0"
  then have "{s .. t}  existence_ivl0 x0"
    by (meson atLeastAtMost_iff is_interval_1 is_interval_existence_ivl subsetI)
  then have "continuous_on {s .. t} (vareq x0)"
    by (auto intro!: continuous_intros)
  then have "compact (vareq x0 ` {s .. t})"
    using compact_Icc
    by (rule compact_continuous_image)
  then obtain B where B: "u. u  {s .. t}  norm (vareq x0 u)  B"
    by (force dest!: compact_imp_bounded simp: bounded_iff)
  show "M L. t{s .. t}. xUNIV. norm (vareq x0 t oL x)  M + L * norm x"
    unfolding o_def
    by (rule exI[where x=0], rule exI[where x=B])
      (auto intro!: order_trans[OF norm_blinfun_compose] mult_right_mono B)
qed (auto intro: assms)

lemma
  assumes "t  existence_ivl0 x0"
  shows "continuous_on (UNIV × existence_ivl0 x0) (λ(x, ta). mvar.flow x0 t x ta)"
proof -
  from mvar.flow_continuous_on_state_space[of x0 t, unfolded mvar_existence_ivl_eq_existence_ivl[OF assms]]
  show "continuous_on (UNIV × existence_ivl0 x0) (λ(x, ta). mvar.flow x0 t x ta)" .
qed

definition "Dflow x0 = mvar.flow x0 0 id_blinfun"

lemma var_eq_mvar:
  assumes "t0  existence_ivl0 x0"
  assumes "t  existence_ivl0 x0"
  shows "var.flow x0 t0 i t = mvar.flow x0 t0 id_blinfun t i"
  by (rule var.flow_unique)
     (auto intro!: assms derivative_eq_intros mvar.flow_has_derivative
       simp: varexivl_eq_exivl assms has_vector_derivative_def blinfun.bilinear_simps)

lemma Dflow_zero[simp]: "x  X  Dflow x 0 = 1L"
  unfolding Dflow_def
  by (subst mvar.flow_initial_time) auto


subsection ‹Differentiability of the flow0›

text U t›, i.e. the solution of the variational equation, is the space derivative at the initial
  value x0›. ›
lemma flow_dx_derivative:
assumes "t  existence_ivl0 x0"
shows "((λx0. flow0 x0 t) has_derivative (λz. vector_Dflow x0 z t)) (at x0)"
  unfolding has_derivative_at2
  using assms
  by (intro iffD1[OF LIM_equal proposition_17_6_weak[OF assms]] conjI[OF bounded_linear_vector_Dflow[OF assms]])
    (simp add: diff_diff_add inverse_eq_divide)

lemma flow_dx_derivative_blinfun:
assumes "t  existence_ivl0 x0"
shows "((λx. flow0 x t) has_derivative Blinfun (λz. vector_Dflow x0 z t)) (at x0)"
by (rule has_derivative_Blinfun[OF flow_dx_derivative[OF assms]])

definition "flowderiv x0 t = comp12 (Dflow x0 t) (blinfun_scaleR_left (f (flow0 x0 t)))"

lemma flowderiv_eq: "flowderiv x0 t (ξ1, ξ2) = (Dflow x0 t) ξ1 + ξ2 *R f (flow0 x0 t)"
  by (auto simp: flowderiv_def)

lemma W_continuous_on: "continuous_on (Sigma X existence_ivl0) (λ(x0, t). Dflow x0 t)"
  ― ‹TODO: somewhere here is hidden continuity wrt rhs of ODE, extract it!›
  unfolding continuous_on split_beta'
proof (safe intro!: tendstoI)
  fix e'::real and t x assume x: "x  X" and tx: "t  existence_ivl0 x" and e': "e' > 0"
  let ?S = "Sigma X existence_ivl0"

  have "(x, t)  ?S" using x tx by auto
  from open_prod_elim[OF open_state_space this]
  obtain OX OT where OXOT: "open OX" "open OT" "(x, t)  OX × OT" "OX × OT  ?S"
    by blast
  then obtain dx dt
  where dx: "dx > 0" "cball x dx  OX"
    and dt: "dt > 0" "cball t dt  OT"
    by (force simp: open_contains_cball)

  from OXOT dt dx have "cball t dt  existence_ivl0 x" "cball x dx  X"
    apply (auto simp: subset_iff)
    subgoal for ta
      apply (drule spec[where x=ta])
      apply (drule spec[where x=t])+
      apply auto
      done
    done

  have one_exivl: "mvar.existence_ivl x 0 = (λ_. existence_ivl0 x)"
    by (rule mvar_existence_ivl_eq_existence_ivl[OF existence_ivl_zero[OF x  X]])

  have *: "closed ({t .. 0}  {0 .. t})" "{t .. 0}  {0 .. t}  {}"
    by auto
  let ?T = "{t .. 0}  {0 .. t}  cball t dt"
  have "compact ?T"
    by (auto intro!: compact_Un)
  have "?T  existence_ivl0 x"
    by (intro Un_least ivl_subset_existence_ivl' ivl_subset_existence_ivl x  X
      t  existence_ivl0 x ‹cball t dt  existence_ivl0 x)

  have "compact (mvar.flow x 0 id_blinfun ` ?T)"
    using ?T  _ x  X
      mvar_existence_ivl_eq_existence_ivl[OF existence_ivl_zero[OF x  X]]
    by (auto intro!: 0 < dx compact_continuous_image ‹compact ?T
      continuous_on_subset[OF mvar.flow_continuous_on])

  let ?line = "mvar.flow x 0 id_blinfun ` ?T"
  let ?X = "{x. infdist x ?line  dx}"
  have "compact ?X"
    using ?T  _ x  X
      mvar_existence_ivl_eq_existence_ivl[OF existence_ivl_zero[OF x  X]]
    by (auto intro!: compact_infdist_le 0 < dx compact_continuous_image compact_Un
      continuous_on_subset[OF mvar.flow_continuous_on ])

  from mvar.local_lipschitz ?T  _
  have llc: "local_lipschitz ?T ?X (λt. (oL) (vareq x t))"
    by (rule local_lipschitz_subset) auto

  have cont: "xa. xa  ?X  continuous_on ?T (λt. vareq x t oL xa)"
    using ?T  _
    by (auto intro!: continuous_intros x  X)

  from local_lipschitz_compact_implies_lipschitz[OF llc ‹compact ?X ‹compact ?T cont]
  obtain K' where K': "ta. ta  ?T  K'-lipschitz_on ?X ((oL) (vareq x ta))"
    by blast
  define K where "K  abs K' + 1"
  have "K > 0"
    by (simp add: K_def)
  have K: "ta. ta  ?T  K-lipschitz_on ?X ((oL) (vareq x ta))"
    by (auto intro!: lipschitz_onI mult_right_mono order_trans[OF lipschitz_onD[OF K']] simp: K_def)

  have ex_ivlI: "y. y  cball x dx  ?T  existence_ivl0 y"
    using dx dt OXOT
    by (intro Un_least ivl_subset_existence_ivl' ivl_subset_existence_ivl; force)

  have cont: "continuous_on ((?T × ?X) × cball x dx) (λ((ta, xa), y). (vareq y ta oL xa))"
    using ‹cball x dx  X ex_ivlI
    by (force intro!: continuous_intros simp: split_beta' )

  have "mvar.flow x 0 id_blinfun t  mvar.flow x 0 id_blinfun ` ({t..0}  {0..t}  cball t dt)"
    by auto
  then have mem: "(t, mvar.flow x 0 id_blinfun t, x)  ?T × ?X × cball x dx"
    by (auto simp: 0 < dx less_imp_le)

  define e where "e  min e' (dx / 2) / 2"
  have "e > 0" using e' > 0 by (auto simp: e_def 0 < dx)
  define d where "d  e * K / (exp (K * (abs t + abs dt + 1)) - 1)"
  have "d > 0" by (auto simp: d_def intro!: mult_pos_pos divide_pos_pos 0 < e K > 0)

  have cmpct: "compact ((?T × ?X) × cball x dx)" "compact (?T × ?X)"
    using ‹compact ?T ‹compact ?X
    by (auto intro!: compact_cball compact_Times)

  have compact_line: "compact ?line"
    using {t..0}  {0..t}  cball t dt  existence_ivl0 x one_exivl
    by (force intro!: compact_continuous_image ‹compact ?T continuous_on_subset[OF mvar.flow_continuous_on] simp: x  X)

  from compact_uniformly_continuous[OF cont cmpct(1), unfolded uniformly_continuous_on_def,
      rule_format, OF 0 < d]
  obtain d' where d': "d' > 0"
    "ta xa xa' y. ta  ?T  xa  ?X  xa'cball x dx  ycball x dx  dist xa' y < d' 
      dist (vareq xa' ta oL xa) (vareq y ta oL xa) < d"
    by (auto simp: dist_prod_def)
  {
    fix y
    assume dxy: "dist x y < d'"
    assume "y  cball x dx"
    then have "y  X"
      using dx dt OXOT by force+

    have two_exivl: "mvar.existence_ivl y 0 = (λ_. existence_ivl0 y)"
      by (rule mvar_existence_ivl_eq_existence_ivl[OF existence_ivl_zero[OF y  X]])

    let ?X' = "x  ?line. ball x dx"
    have "open ?X'" by auto
    have "?X'  ?X"
      by (auto intro!: infdist_le2 simp: dist_commute)

    interpret oneR: ll_on_open "existence_ivl0 x" "(λt. (oL) (vareq x t))" ?X'
      by standard (auto intro!: x  X continuous_intros local_lipschitz_A[OF order_refl])
    interpret twoR: ll_on_open "existence_ivl0 y" "(λt. (oL) (vareq y t))" ?X'
      by standard (auto intro!: y  X continuous_intros local_lipschitz_A[OF order_refl])
    interpret both:
      two_ll_on_open "(λt. (oL) (vareq x t))" "existence_ivl0 x" "(λt. (oL) (vareq y t))" "existence_ivl0 y" ?X' ?T "id_blinfun" d K
    proof unfold_locales
      show "0 < K" by (simp add: 0 < K)
      show iv_defined: "0  {t..0}  {0..t}  cball t dt"
        by auto
      show "is_interval ({t..0}  {0..t}  cball t dt)"
        by (auto simp: is_interval_def dist_real_def)
      show "{t..0}  {0..t}  cball t dt  oneR.existence_ivl 0 id_blinfun"
        apply (rule oneR.maximal_existence_flow[where x="mvar.flow x 0 id_blinfun"])
        subgoal
          apply (rule solves_odeI)
          apply (rule has_vderiv_on_subset[OF solves_odeD(1)[OF mvar.flow_solves_ode[of 0 x id_blinfun]]])
          subgoal using x  X ?T  _ 0 < dx by simp
          subgoal by simp
          subgoal by (simp add: ‹cball t dt  existence_ivl0 x ivl_subset_existence_ivl ivl_subset_existence_ivl' one_exivl tx)
          subgoal using dx by (auto; force)
          done
        subgoal by (simp add: x  X)
        subgoal by fact
        subgoal using iv_defined by blast
        subgoal using {t..0}  {0..t}  cball t dt  existence_ivl0 x by blast
        done
      fix s assume s: "s  ?T"
      then show "K-lipschitz_on ?X' ((oL) (vareq x s))"
        by (intro lipschitz_on_subset[OF K ?X'  ?X]) auto
      fix j assume j: "j  ?X'"
      show "norm ((vareq x s oL j) - (vareq y s oL j)) < d"
        unfolding dist_norm[symmetric]
        apply (rule d')
        subgoal by (rule s)
        subgoal using ?X'  ?X j ..
        subgoal using dx > 0 by simp
        subgoal using y  cball x dx by simp
        subgoal using dxy by simp
        done
    qed
    have less_e: "norm (Dflow x s - both.Y s) < e"
      if s: "s  ?T  twoR.existence_ivl 0 id_blinfun" for s
    proof -
      from s have s_less: "¦s¦ < ¦t¦ + ¦dt¦ + 1"
        by (auto simp: dist_real_def)
      note both.norm_X_Y_bound[rule_format, OF s]
      also have "d / K * (exp (K * ¦s¦) - 1) =
          e * ((exp (K * ¦s¦) - 1) / (exp (K * (¦t¦ + ¦dt¦ + 1)) - 1))"
        by (simp add: d_def)
      also have " < e * 1"
        by (rule mult_strict_left_mono[OF _ 0 < e])
           (simp add: add_nonneg_pos 0 < K 0 < e s_less)
      also have " = e" by simp
      also
      from s have s: "s  ?T" by simp
      have "both.flow0 s = Dflow x s"
        unfolding both.flow0_def Dflow_def
        apply (rule oneR.maximal_existence_flow[where K="?T"])
        subgoal
          apply (rule solves_odeI)
          apply (rule has_vderiv_on_subset[OF solves_odeD(1)[OF mvar.flow_solves_ode[of 0 x id_blinfun]]])
          subgoal using x  X 0 < dx by simp
          subgoal by simp
          subgoal by (simp add: ‹cball t dt  existence_ivl0 x ivl_subset_existence_ivl ivl_subset_existence_ivl' one_exivl tx)
          subgoal using dx by (auto; force)
          done
        subgoal by (simp add: x  X)
        subgoal by (rule both.J_ivl)
        subgoal using both.t0_in_J by blast
        subgoal using {t..0}  {0..t}  cball t dt  existence_ivl0 x by blast
        subgoal using s by blast
        done
      finally show ?thesis .
    qed

    have "e < dx" using dx > 0 by (auto simp: e_def)

    let ?i = "{y. infdist y (mvar.flow x 0 id_blinfun ` ?T)  e}"
    have 1: "?i  (xmvar.flow x 0 id_blinfun ` ?T. ball x dx)"
    proof -
      have cl: "closed ?line" "?line  {}" using compact_line
        by (auto simp: compact_imp_closed)
      have "?i  (ymvar.flow x 0 id_blinfun ` ?T. cball y e)"
      proof safe
        fix x
        assume H: "infdist x ?line  e"
        from infdist_attains_inf[OF cl, of x]
        obtain y where "y  ?line" "infdist x ?line = dist x y" by auto
        then show "x  (x?line. cball x e)"
          using H
          by (auto simp: dist_commute)
      qed
      also have "  (x?line. ball x dx)"
        using e < dx
        by auto
      finally show ?thesis .
    qed
    have 2: "twoR.flow 0 id_blinfun s  ?i"
      if "s  ?T" "s  twoR.existence_ivl 0 id_blinfun" for s
    proof -
      from that have sT: "s  ?T  twoR.existence_ivl 0 id_blinfun"
        by force
      from less_e[OF this]
      have "dist (twoR.flow 0 id_blinfun s) (mvar.flow x 0 id_blinfun s)  e"
        unfolding Dflow_def both.Y_def dist_commute dist_norm by simp
      then show ?thesis
        using sT by (force intro: infdist_le2)
    qed
    have T_subset: "?T  twoR.existence_ivl 0 id_blinfun"
      apply (rule twoR.subset_mem_compact_implies_subset_existence_interval[
          where K="{x. infdist x ?line  e}"])
      subgoal using 0 < dt by force
      subgoal by (rule both.J_ivl)
      subgoal using y  cball x dx ex_ivlI by blast
      subgoal using both.F_iv_defined(2) by blast
      subgoal by (rule 2)
      subgoal using dt > 0 by (intro compact_infdist_le) (auto intro!: compact_line 0 < e)
      subgoal by (rule 1)
      done
    also have "twoR.existence_ivl 0 id_blinfun  existence_ivl0 y"
      by (rule twoR.existence_ivl_subset)
    finally have "?T  existence_ivl0 y" .
    have "norm (Dflow x s - Dflow y s) < e" if s: "s  ?T" for s
    proof -
      from s have "s  ?T  twoR.existence_ivl 0 id_blinfun" using T_subset by force
      from less_e[OF this] have "norm (Dflow x s - both.Y s) < e" .
      also have "mvar.flow y 0 id_blinfun s = twoR.flow 0 id_blinfun s"
        apply (rule mvar.maximal_existence_flow[where K="?T"])
        subgoal
          apply (rule solves_odeI)
          apply (rule has_vderiv_on_subset[OF solves_odeD(1)[OF twoR.flow_solves_ode[of 0 id_blinfun]]])
          subgoal using y  X by simp
          subgoal using both.F_iv_defined(2) by blast
          subgoal using T_subset by blast
          subgoal by simp
          done
        subgoal using y  X auto_ll_on_open.existence_ivl_zero auto_ll_on_open_axioms both.F_iv_defined(2) twoR.flow_initial_time by blast
        subgoal by (rule both.J_ivl)
        subgoal using both.t0_in_J by blast
        subgoal using {t..0}  {0..t}  cball t dt  existence_ivl0 y by blast
        subgoal using s by blast
        done
      then have "both.Y s = Dflow y s"
        unfolding both.Y_def Dflow_def
        by simp
      finally show ?thesis .
    qed
  } note cont_data = this
  have "F (y, s) in at (x, t) within ?S. dist x y < d'"
    unfolding at_within_open[OF (x, t)  ?S open_state_space] UNIV_Times_UNIV[symmetric]
    using d' > 0
    by (intro eventually_at_Pair_within_TimesI1)
      (auto simp: eventually_at less_imp_le dist_commute)
  moreover
  have "F (y, s) in at (x, t) within ?S. y  cball x dx"
    unfolding at_within_open[OF (x, t)  ?S open_state_space] UNIV_Times_UNIV[symmetric]
    using dx > 0
    by (intro eventually_at_Pair_within_TimesI1)
      (auto simp: eventually_at less_imp_le dist_commute)
  moreover
  have "F (y, s) in at (x, t) within ?S. s  ?T"
    unfolding at_within_open[OF (x, t)  ?S open_state_space] UNIV_Times_UNIV[symmetric]
    using dt > 0
    by (intro eventually_at_Pair_within_TimesI2)
      (auto simp: eventually_at less_imp_le dist_commute)
  moreover
  have "0  existence_ivl0 x" by (simp add: x  X)
  have "F y in at t within existence_ivl0 x. dist (mvar.flow x 0 id_blinfun y) (mvar.flow x 0 id_blinfun t) < e"
    using mvar.flow_continuous_on[of x 0 id_blinfun]
    using 0 < e tx
    by (auto simp add: continuous_on one_exivl dest!: tendstoD)
  then have "F (y, s) in at (x, t) within ?S. dist (Dflow x s) (Dflow x t) < e"
    using 0 < e
    unfolding at_within_open[OF (x, t)  ?S open_state_space] UNIV_Times_UNIV[symmetric] Dflow_def
    by (intro eventually_at_Pair_within_TimesI2)
      (auto simp: at_within_open[OF tx open_existence_ivl])
  ultimately
  have "F (y, s) in at (x, t) within ?S. dist (Dflow y s) (Dflow x t) < e'"
    apply eventually_elim
  proof (safe del: UnE, goal_cases)
    case (1 y s)
    have "dist (Dflow y s) (Dflow x t)  dist (Dflow y s) (Dflow x s) + dist (Dflow x s) (Dflow x t)"
      by (rule dist_triangle)
    also
    have "dist (Dflow x s) (Dflow x t) < e"
      by (rule 1)
    also have "dist (Dflow y s) (Dflow x s) < e"
      unfolding dist_norm norm_minus_commute
      using 1
      by (intro cont_data)
    also have "e + e  e'" by (simp add: e_def)
    finally show "dist (Dflow y s) (Dflow x t) < e'" by arith
  qed
  then show "F ys in at (x, t) within ?S. dist (Dflow (fst ys) (snd ys)) (Dflow (fst (x, t)) (snd (x, t))) < e'"
    by (simp add: split_beta')
qed

lemma W_continuous_on_comp[continuous_intros]:
  assumes h: "continuous_on S h" and g: "continuous_on S g"
  shows "(s. s  S  h s  X)  (s. s  S  g s  existence_ivl0 (h s)) 
    continuous_on S (λs. Dflow (h s) (g s))"
  using continuous_on_compose[OF continuous_on_Pair[OF h g] continuous_on_subset[OF W_continuous_on]]
  by auto

lemma f_flow_continuous_on: "continuous_on (Sigma X existence_ivl0) (λ(x0, t). f (flow0 x0 t))"
  using flow_continuous_on_state_space
  by (auto intro!: continuous_on_f flow_in_domain simp: split_beta')

lemma
  flow_has_space_derivative:
  assumes "t  existence_ivl0 x0"
  shows "((λx0. flow0 x0 t) has_derivative Dflow x0 t) (at x0)"
  by (rule flow_dx_derivative_blinfun[THEN has_derivative_eq_rhs])
    (simp_all add: var_eq_mvar assms blinfun.blinfun_apply_inverse Dflow_def vector_Dflow_def
      mem_existence_ivl_iv_defined[OF assms])

lemma
  flow_has_flowderiv:
  assumes "t  existence_ivl0 x0"
  shows "((λ(x0, t). flow0 x0 t) has_derivative flowderiv x0 t) (at (x0, t) within S)"
proof -
  have Sigma: "(x0, t)  Sigma X existence_ivl0"
    using assms by auto
  from open_state_space assms obtain e' where e': "e' > 0" "ball (x0, t) e'  Sigma X existence_ivl0"
    by (force simp: open_contains_ball)
  define e where "e = e' / sqrt 2"
  have "0 < e" using e' by (auto simp: e_def)
  have "ball x0 e × ball t e  ball (x0, t) e'"
    by (auto simp: dist_prod_def real_sqrt_sum_squares_less e_def)
  also note e'(2)
  finally have subs: "ball x0 e × ball t e  Sigma X existence_ivl0" .


  have d1: "((λx0. flow0 x0 s) has_derivative blinfun_apply (Dflow y s)) (at y within ball x0 e)"
    if "y  ball x0 e" "s  ball t e" for y s
    using subs that
    by (subst at_within_open; force intro!: flow_has_space_derivative)
  have d2: "(flow0 y has_derivative blinfun_apply (blinfun_scaleR_left (f (flow0 y s)))) (at s within ball t e)"
    if "y  ball x0 e" "s  ball t e" for y s
    using subs that
    unfolding has_vector_derivative_eq_has_derivative_blinfun[symmetric]
    by (subst at_within_open; force intro!: flow_has_vector_derivative)
  have "((λ(x0, t). flow0 x0 t) has_derivative flowderiv x0 t) (at (x0, t) within ball x0 e × ball t e)"
    using subs
    unfolding UNIV_Times_UNIV[symmetric]
    by (intro has_derivative_partialsI[OF d1 d2, THEN has_derivative_eq_rhs])
       (auto intro!: 0 < e continuous_intros flow_in_domain
          continuous_on_imp_continuous_within[where s="Sigma X existence_ivl0"]
          assms
        simp: flowderiv_def split_beta' flow0_defined assms mem_ball)
  then have "((λ(x0, t). flow0 x0 t) has_derivative flowderiv x0 t) (at (x0, t) within Sigma X existence_ivl0)"
    by (auto simp: at_within_open[OF _ open_state_space] at_within_open[OF _ open_Times] assms 0 < e
        mem_existence_ivl_iv_defined[OF assms])
  then show ?thesis unfolding at_within_open[OF Sigma open_state_space]
    by (rule has_derivative_at_withinI)
qed

lemma flow0_comp_has_derivative:
  assumes h: "h s  existence_ivl0 (g s)"
  assumes [derivative_intros]: "(g has_derivative g') (at s within S)"
  assumes [derivative_intros]: "(h has_derivative h') (at s within S)"
  shows "((λx. flow0 (g x) (h x)) has_derivative (λx. blinfun_apply (flowderiv (g s) (h s)) (g' x, h' x)))
     (at s within S)"
  by (rule has_derivative_compose[where f="λx. (g x, h x)" and s=S,
        OF _ flow_has_flowderiv[OF h], simplified])
    (auto intro!: derivative_eq_intros)

lemma flowderiv_continuous_on: "continuous_on (Sigma X existence_ivl0) (λ(x0, t). flowderiv x0 t)"
  unfolding flowderiv_def split_beta'
  by (subst blinfun_of_matrix_works[where f="comp12 (Dflow (fst x) (snd x))
            (blinfun_scaleR_left (f (flow0 (fst x) (snd x))))" for x, symmetric])
    (auto intro!: continuous_intros flow_in_domain)

lemma flowderiv_continuous_on_comp[continuous_intros]:
  assumes "continuous_on S x"
  assumes "continuous_on S t"
  assumes "s. s  S  x s  X" "s. s  S  t s  existence_ivl0 (x s)"
  shows "continuous_on S (λxa. flowderiv (x xa) (t xa))"
  by (rule continuous_on_compose2[OF flowderiv_continuous_on, where f="λs. (x s, t s)",
        unfolded split_beta' fst_conv snd_conv])
    (auto intro!: continuous_intros assms)

lemmas [intro] = flow_in_domain

lemma vareq_trans: "t0  existence_ivl0 x0  t  existence_ivl0 (flow0 x0 t0) 
  vareq (flow0 x0 t0) t = vareq x0 (t0 + t)"
  by (auto simp: vareq_def flow_trans)

lemma diff_existence_ivl_trans:
  "t0  existence_ivl0 x0  t  existence_ivl0 x0  t - t0  existence_ivl0 (flow0 x0 t0)" for t
  by (metis (no_types, hide_lams) add.left_neutral diff_add_eq
      local.existence_ivl_reverse local.existence_ivl_trans local.flows_reverse)

lemma has_vderiv_on_blinfun_compose_right[derivative_intros]:
  assumes "(g has_vderiv_on g') T"
  assumes "x. x  T  gd' x = g' x oL d"
  shows "((λx. g x oL d) has_vderiv_on gd') T"
  using assms
  by (auto simp: has_vderiv_on_def has_vector_derivative_def blinfun_ext blinfun.bilinear_simps
      intro!: derivative_eq_intros ext)

lemma has_vderiv_on_blinfun_compose_left[derivative_intros]:
  assumes "(g has_vderiv_on g') T"
  assumes "x. x  T  gd' x = d oL g' x"
  shows "((λx. d oL g x) has_vderiv_on gd') T"
  using assms
  by (auto simp: has_vderiv_on_def has_vector_derivative_def blinfun_ext blinfun.bilinear_simps
      intro!: derivative_eq_intros ext)

lemma mvar_flow_shift:
  assumes "t0  existence_ivl0 x0" "t1  existence_ivl0 x0"
  shows "mvar.flow x0 t0 d t1 = Dflow (flow0 x0 t0) (t1 - t0) oL d"
proof -
  have "mvar.flow x0 t0 d t1 = mvar.flow x0 t0 d (t0 + (t1 - t0))"
    by simp
  also have " = mvar.flow x0 t0 (mvar.flow x0 t0 d t0) t1"
    by (subst mvar.flow_trans) (auto simp add: assms)
  also have " = Dflow (flow0 x0 t0) (t1 - t0) oL d"
    apply (rule mvar.flow_unique_on)
       apply (auto simp add: assms mvar.flow_initial_time_if blinfun_ext Dflow_def
        intro!: derivative_intros derivative_eq_intros)
      apply (auto simp: assms has_vderiv_on_open has_vector_derivative_def
        intro!: derivative_eq_intros blinfun_eqI)
     apply (subst mvar_existence_ivl_eq_existence_ivl)
    by (auto simp add: vareq_trans assms diff_existence_ivl_trans)
  finally show ?thesis .
qed

lemma Dflow_trans:
  assumes "h  existence_ivl0 x0"
  assumes "i  existence_ivl0 (flow0 x0 h)"
  shows "Dflow x0 (h + i) = Dflow (flow0 x0 h) i oL (Dflow x0 h)"
proof -
  have [intro, simp]: "h + i  existence_ivl0 x0" "i + h  existence_ivl0 x0" "x0  X"
    using assms
    by (auto simp add: add.commute existence_ivl_trans)
  show ?thesis
    unfolding Dflow_def
    apply (subst mvar.flow_trans[where s=h and t=i])
    subgoal by (auto simp: assms)
    subgoal by (auto simp: assms)
    by (subst mvar_flow_shift) (auto simp: assms Dflow_def )
qed

lemma Dflow_trans_apply:
  assumes "h  existence_ivl0 x0"
  assumes "i  existence_ivl0 (flow0 x0 h)"
  shows "Dflow x0 (h + i) d0 = Dflow (flow0 x0 h) i (Dflow x0 h d0)"
proof -
  have [intro, simp]: "h + i  existence_ivl0 x0" "i + h  existence_ivl0 x0" "x0  X"
    using assms
    by (auto simp add: add.commute existence_ivl_trans)
  show ?thesis
    unfolding Dflow_def
    apply (subst mvar.flow_trans[where s=h and t=i])
    subgoal by (auto simp: assms)
    subgoal by (auto simp: assms)
    by (subst mvar_flow_shift) (auto simp: assms Dflow_def )
qed


end ― ‹@{thm c1_on_open_euclidean_anchor}

end

Theory Upper_Lower_Solution

section ‹Upper and Lower Solutions›
theory Upper_Lower_Solution
imports Flow
begin

text ‹Following  Walter~\cite{walter} in section 9›

lemma IVT_min:
  fixes f :: "real  'b :: {linorder_topology,real_normed_vector,ordered_real_vector}"
  ― ‹generalize?›
  assumes y: "f a  y" "y  f b" "a  b"
  assumes *: "continuous_on {a .. b} f"
  notes [continuous_intros] = *[THEN continuous_on_subset]
  obtains x where "a  x" "x  b" "f x = y" "x'. a  x'  x' < x  f x' < y"
proof -
  let ?s = "((λx. f x - y) -` {0..})  {a..b}"
  have "?s  {}"
    using assms
    by auto
  have "closed ?s"
    by (rule closed_vimage_Int) (auto intro!: continuous_intros)
  moreover have "bounded ?s"
    by (rule bounded_Int) (simp add: bounded_closed_interval)
  ultimately have "compact ?s"
    using compact_eq_bounded_closed by blast
  from compact_attains_inf[OF this ?s  {}]
  obtain x where x: "a  x" "x  b" "f x  y"
    and min: "z. a  z  z  b  f z  y  x  z"
    by auto
  have "f x  y"
  proof (rule ccontr)
    assume n: "¬ f x  y"
    then have "za. z  x  (λx. f x - y) z = 0"
      using x by (intro IVT') (auto intro!: continuous_intros simp: assms)
    then obtain z where z: "a  z" "z  x" "f z = y" by auto
    then have "a  z" "z  b" "f z  y" using x by auto
    from min [OF this] z n
    show False by auto
  qed
  then have "a  x" "x  b" "f x = y"
    using x
    by (auto )
  moreover have "f x' < y" if "a  x'" "x' < x" for x'
    apply (rule ccontr)
    using min[of x'] that x
    by (auto simp: not_less)
  ultimately show ?thesis ..
qed

lemma filtermap_at_left_shift: "filtermap (λx. x - d) (at_left a) = at_left (a - d::real)"
  by (simp add: filter_eq_iff eventually_filtermap eventually_at_filter filtermap_nhds_shift[symmetric])

context
  fixes v v' w w'::"real  real" and t0 t1 e::real
  assumes v': "(v has_vderiv_on v') {t0 <.. t1}"
    and w': "(w has_vderiv_on w') {t0 <.. t1}"
  assumes pos_ivl: "t0 < t1"
  assumes e_pos: "e > 0" and e_in: "t0 + e  t1"
  assumes less:  "t. t0 < t  t < t0 + e  v t < w t"
begin

lemma first_intersection_crossing_derivatives:
  assumes na: "t0 < tg" "tg  t1" "v tg  w tg"
  notes [continuous_intros] =
    vderiv_on_continuous_on[OF v', THEN continuous_on_subset]
    vderiv_on_continuous_on[OF w', THEN continuous_on_subset]
  obtains x0 where
    "t0 < x0" "x0  tg"
    "v' x0  w' x0"
    "v x0 = w x0"
    "t. t0 < t  t < x0  v t < w t"
proof -
  have "(v - w) (min tg (t0 + e / 2))  0" "0  (v - w) tg"
    "min tg (t0 + e / 2)  tg"
    "continuous_on {min tg (t0 + e / 2)..tg} (v - w)"
  using less[of "t0 + e / 2"]
    less[of tg]na e > 0
    by (auto simp: min_def intro!: continuous_intros)
  from IVT_min[OF this]
  obtain x0 where x0: "min tg (t0 + e / 2)  x0" "x0  tg" "v x0 = w x0"
    "x'. min tg (t0 + e / 2)  x'  x' < x0  v x' < w x'"
    by auto
  then have x0_in: "t0 < x0" "x0  t1"
    using e > 0 na(1,2)
    by (auto)
  note t0 < x0 x0  tg
  moreover
  {
    from v' x0_in
    have "(v has_derivative (λx. x * v' x0)) (at x0 within {t0<..<x0})"
      by (force intro: has_derivative_subset simp: has_vector_derivative_def has_vderiv_on_def)
    then have v: "((λy. (v y - (v x0 + (y - x0) * v' x0)) / norm (y - x0))  0) (at x0 within {t0<..<x0})"
      unfolding has_derivative_within
      by (simp add: ac_simps)
    from w' x0_in
    have "(w has_derivative (λx. x * w' x0)) (at x0 within {t0<..<x0})"
      by (force intro: has_derivative_subset simp: has_vector_derivative_def has_vderiv_on_def)
    then have w: "((λy. (w y - (w x0 + (y - x0) * w' x0)) / norm (y - x0))  0) (at x0 within {t0<..<x0})"
      unfolding has_derivative_within
      by (simp add: ac_simps)

    have evs: "F x in at x0 within {t0<..<x0}. min tg (t0 + e / 2) < x"
      "F x in at x0 within {t0<..<x0}. t0 < x  x < x0"
      using less na(1) na(3) x0(3) x0_in(1)
      by (force simp: min_def eventually_at_filter intro!: order_tendstoD[OF tendsto_ident_at])+
    then have "F x in at x0 within {t0<..<x0}.
       (v x - (v x0 + (x - x0) * v' x0)) / norm (x - x0) - (w x - (w x0 + (x - x0) * w' x0)) / norm (x - x0) =
       (v x - w x) / norm (x - x0) + (v' x0 - w' x0)"
       apply eventually_elim
       using x0_in x0 less na t0 < t1 sum_sqs_eq
       by (auto simp: divide_simps algebra_simps min_def intro!: eventuallyI split: if_split_asm)
    from this tendsto_diff[OF v w]
    have 1: "((λx. (v x - w x) / norm (x - x0) + (v' x0 - w' x0))  0) (at x0 within {t0<..<x0})"
      by (force intro: tendsto_eq_rhs Lim_transform_eventually)
    moreover
    from evs have 2: "F x in at x0 within {t0<..<x0}. (v x - w x) / norm (x - x0) + (v' x0 - w' x0)  (v' x0 - w' x0)"
      by eventually_elim (auto simp: divide_simps intro!: less_imp_le x0(4))

    moreover
    have "at x0 within {t0<..<x0}  bot"
      by (simp add: t0 < x0 at_within_eq_bot_iff less_imp_le)

    ultimately
    have "0  v' x0 - w' x0"
      by (rule tendsto_upperbound)
    then have "v' x0  w' x0" by simp
  }
  moreover note v x0 = w x0
  moreover
  have "t0 < t  t < x0  v t < w t" for t
    by (cases "min tg (t0 + e / 2)  t") (auto intro: x0 less)
  ultimately show ?thesis ..
qed

lemma defect_less:
  assumes b: "t. t0 < t  t  t1  v' t - f t (v t) < w' t - f t (w t)"
  notes [continuous_intros] =
    vderiv_on_continuous_on[OF v', THEN continuous_on_subset]
    vderiv_on_continuous_on[OF w', THEN continuous_on_subset]
  shows "t  {t0 <.. t1}. v t < w t"
proof (rule ccontr)
  assume " ¬ (t{t0 <.. t1}. v t < w t)"
  then obtain tu where "t0 < tu" "tu  t1" "v tu  w tu" by auto
  from first_intersection_crossing_derivatives[OF this]
  obtain x0 where "t0 < x0" "x0  tu" "w' x0  v' x0" "v x0 = w x0" "t. t0 < t  t < x0  v t < w t"
    by metis
  with b[of x0] tu  t1
  show False
    by simp
qed

end

lemma has_derivatives_less_lemma:
  fixes v v' ::"real  real"
  assumes v': "(v has_vderiv_on v') T"
  assumes y': "(y has_vderiv_on y') T"
  assumes lu: "t. t  T  t > t0  v' t - f t (v t) < y' t - f t (y t)"
  assumes lower: "v t0  y t0"
  assumes eq_imp: "v t0 = y t0  v' t0 < y' t0"
  assumes t: "t0 < t" "t0  T" "t  T" "is_interval T"
  shows "v t < y t"
proof -
  have subset: "{t0 .. t}  T"
    by (rule atMostAtLeast_subset_convex) (auto simp: assms is_interval_convex)
  obtain d where "0 < d" "t0 < s  s  t  s < t0 + d  v s < y s" for s
  proof cases
    assume "v t0 = y t0"
    from this[THEN eq_imp]
    have *: "0 < y' t0 - v' t0"
      by (simp add: )
    have "((λt. y t - v t) has_vderiv_on (λt0. y' t0 - v' t0)) {t0 .. t}"
      by (auto intro!: derivative_intros y' v' has_vderiv_on_subset[OF _ subset])
    with t0 < t
    have d: "((λt. y t - v t) has_real_derivative y' t0 - v' t0) (at t0 within {t0 .. t})"
      by (auto simp: has_vderiv_on_def has_field_derivative_iff_has_vector_derivative)
    from has_real_derivative_pos_inc_right[OF d *] v t0 = y t0
    obtain d where "d > 0" and vy: "h > 0  t0 + h  t  h < d  v (t0 + h) < y (t0 + h)" for h
      by auto
    have vy: "t0 < s  s  t  s < t0 + d  v s < y s" for s
      using vy[of "s - t0"] by simp
    with d > 0 show ?thesis ..
  next
    assume "v t0  y t0"
    then have "v t0 < y t0" using lower by simp
    moreover
    have "continuous_on {t0 .. t} v" "continuous_on {t0 .. t} y"
      by (auto intro!: vderiv_on_continuous_on assms has_vderiv_on_subset[OF _ subset])
    then have "(v  v t0) (at t0 within {t0 .. t})" "(y  y t0) (at t0 within {t0 .. t})"
      by (auto simp: continuous_on)
    ultimately have "F x in at t0 within {t0 .. t}. 0 < y x - v x"
      by (intro order_tendstoD) (auto intro!: tendsto_eq_intros)
    then obtain d where "d > 0" "x. t0 < x  x  t  x < t0 + d  v x < y x"
      by atomize_elim (auto simp: eventually_at algebra_simps dist_real_def)
    then show ?thesis ..
  qed
  with d > 0 t0 < t
  obtain e where "e > 0" "t0 + e  t" "t0 < s  s < t0 + e  v s < y s" for s
    by atomize_elim (auto simp: min_def divide_simps intro!: exI[where x="min (d/2) ((t - t0) / 2)"]
        split: if_split_asm)
  from defect_less[
      OF has_vderiv_on_subset[OF v']
        has_vderiv_on_subset[OF y']
        t0 < t
        this lu]
  show "v t < y t" using t0 < t subset
    by (auto simp: subset_iff assms)
qed

lemma strict_lower_solution:
  fixes v v' ::"real  real"
  assumes sol: "(y solves_ode f) T X"
  assumes v': "(v has_vderiv_on v') T"
  assumes lower: "t. t  T  t > t0  v' t < f t (v t)"
  assumes iv: "v t0  y t0" "v t0 = y t0  v' t0 < f t0 (y t0)"
  assumes t: "t0 < t" "t0  T" "t  T" "is_interval T"
  shows "v t < y t"
proof -
  note v'
  moreover
  note solves_odeD(1)[OF sol]
  moreover
  have 3: "v' t - f t (v t) < f t (y t) - f t (y t)" if "t  T" "t > t0" for t
    using lower(1)[OF that]
    by arith
  moreover note iv
  moreover note t
  ultimately
  show "v t < y t"
    by (rule has_derivatives_less_lemma)
qed

lemma strict_upper_solution:
  fixes w w'::"real  real"
  assumes sol: "(y solves_ode f) T X"
  assumes w': "(w has_vderiv_on w') T"
    and upper: "t. t  T  t > t0  f t (w t) < w' t"
    and iv: "y t0  w t0" "y t0 = w t0  f t0 (y t0) < w' t0"
  assumes t: "t0 < t" "t0  T" "t  T" "is_interval T"
  shows "y t < w t"
proof -
  note solves_odeD(1)[OF sol]
  moreover
  note w'
  moreover
  have "f t (y t) - f t (y t) < w' t - f t (w t)" if "t  T" "t > t0" for t
    using upper(1)[OF that]
    by arith
  moreover note iv
  moreover note t
  ultimately
  show "y t < w t"
    by (rule has_derivatives_less_lemma)
qed

lemma uniform_limit_at_within_subset:
  assumes "uniform_limit S x l (at t within T)"
  assumes "U  T"
  shows "uniform_limit S x l (at t within U)"
  by (metis assms(1) assms(2) eventually_within_Un filterlim_iff subset_Un_eq)

lemma uniform_limit_le:
  fixes f::"'c  'a  'b::{metric_space, linorder_topology}"
  assumes I: "I  bot"
  assumes u: "uniform_limit X f g I"
  assumes u': "uniform_limit X f' g' I"
  assumes "F i in I. x  X. f i x  f' i x"
  assumes "x  X"
  shows "g x  g' x"
proof -
  have "F i in I. f i x  f' i x" using assms by (simp add: eventually_mono)
  with I tendsto_uniform_limitI[OF u' x  X] tendsto_uniform_limitI[OF u x  X]
  show ?thesis by (rule tendsto_le)
qed

lemma uniform_limit_le_const:
  fixes f::"'c  'a  'b::{metric_space, linorder_topology}"
  assumes I: "I  bot"
  assumes u: "uniform_limit X f g I"
  assumes "F i in I. x  X. f i x  h x"
  assumes "x  X"
  shows "g x  h x"
proof -
  have "F i in I. f i x  h x" using assms by (simp add: eventually_mono)
  then show ?thesis by (metis tendsto_upperbound I tendsto_uniform_limitI[OF u x  X])
qed

lemma uniform_limit_ge_const:
  fixes f::"'c  'a  'b::{metric_space, linorder_topology}"
  assumes I: "I  bot"
  assumes u: "uniform_limit X f g I"
  assumes "F i in I. x  X. h x  f i x"
  assumes "x  X"
  shows "h x  g x"
proof -
  have "F i in I. h x  f i x" using assms by (simp add: eventually_mono)
  then show ?thesis by (metis tendsto_lowerbound I tendsto_uniform_limitI[OF u x  X])
qed

locale ll_on_open_real = ll_on_open T f X for T f and X::"real set"
begin

lemma lower_solution:
  fixes v v' ::"real  real"
  assumes sol: "(y solves_ode f) S X"
  assumes v': "(v has_vderiv_on v') S"
  assumes lower: "t. t  S  t > t0  v' t < f t (v t)"
  assumes iv: "v t0  y t0"
  assumes t: "t0  t" "t0  S" "t  S" "is_interval S" "S  T"
  shows "v t  y t"
proof cases
  assume "v t0 = y t0"
  have "{t0 -- t}  S" using t by (simp add: closed_segment_subset is_interval_convex)
  with sol have "(y solves_ode f) {t0 -- t} X" using order_refl by (rule solves_ode_on_subset)
  moreover note refl
  moreover
  have "{t0 -- t}  T" using {t0 -- t}  S S  T by (rule order_trans)
  ultimately have t_ex: "t  existence_ivl t0 (y t0)"
    by (rule existence_ivl_maximal_segment)

  have t0_ex: "t0  existence_ivl t0 (y t0)"
    using in_existence_between_zeroI t_ex by blast
  have "t0  T" using assms(9) t(2) by blast

  from uniform_limit_flow[OF t0_ex t_ex] t0  t
  have "uniform_limit {t0..t} (flow t0) (flow t0 (y t0)) (at (y t0))" by simp
  then have "uniform_limit {t0..t} (flow t0) (flow t0 (y t0)) (at_right (y t0))"
    by (rule uniform_limit_at_within_subset) simp
  moreover
  {
    have "F i in at (y t0). t  existence_ivl t0 i"
      by (rule eventually_mem_existence_ivl) fact
    then have "F i in at_right (y t0). t  existence_ivl t0 i"
      unfolding eventually_at_filter
      by eventually_elim simp
    moreover have "F i in at_right (y t0). i  X"
    proof -
      have f1: "r ra rb. r  existence_ivl ra rb  rb  X"
        by (metis existence_ivl_reverse flow_in_domain flows_reverse)
      obtain rr :: "(real  bool)  (real  bool)  real" where
        "p f pa fa. (¬ eventually p f  eventually pa f  p (rr p pa)) 
          (¬ eventually p fa  ¬ pa (rr p pa)  eventually pa fa)"
        by (metis (no_types) eventually_mono)
      then show ?thesis
        using f1 calculation by meson
    qed
    moreover have "F i in at_right (y t0). y t0 < i"
      by (simp add: eventually_at_filter)
    ultimately have "F i in at_right (y t0). x{t0..t}. v x  flow t0 i x"
    proof eventually_elim
      case (elim y')
      show ?case
      proof safe
        fix s assume s: "s  {t0..t}"
        show "v s  flow t0 y' s"
        proof cases
          assume "s = t0" with elim iv show ?thesis
            by (simp add: t0  T y'  X)
        next
          assume "s  t0" with s have "t0 < s" by simp
          have "{t0 -- s}  S" using {t0--t}  S closed_segment_eq_real_ivl s by auto
          from s elim have "{t0..s}  existence_ivl t0 y'"
            using ivl_subset_existence_ivl by blast
          with flow_solves_ode have sol: "(flow t0 y' solves_ode f) {t0 .. s} X"
            by (rule solves_ode_on_subset) (auto intro!: y'  X t0  T)
          have "{t0 .. s}  S" using {t0 -- s}  S by (simp add: closed_segment_eq_real_ivl split: if_splits)
          with v' have v': "(v has_vderiv_on v') {t0 .. s}"
            by (rule has_vderiv_on_subset)
          from y t0 < y' v t0 = y t0 have less_init: "v t0 < flow t0 y' t0"
            by (simp add: flow_initial_time_if t0  T y'  X)
          from strict_lower_solution[OF sol v' lower less_imp_le[OF less_init] _ t0 < s]
            {t0 .. s}  S
            less_init t0 < s
          have "v s < flow t0 y' s" by (simp add: subset_iff is_interval_cc)
          then show ?thesis by simp
        qed
      qed
    qed
  }
  moreover have "t  {t0 .. t}" using t0  t by simp
  ultimately have "v t  flow t0 (y t0) t"
    by (rule uniform_limit_ge_const[OF trivial_limit_at_right_real])
  also have "flow t0 (y t0) t = y t"
    using sol t
    by (intro maximal_existence_flow) auto
  finally show ?thesis .
next
  assume "v t0  y t0" then have less: "v t0 < y t0" using iv by simp
  show ?thesis
    apply (cases "t0 = t")
    subgoal using iv by blast
    subgoal using strict_lower_solution[OF sol v' lower iv] less t by force
    done
qed

lemma upper_solution:
  fixes v v' ::"real  real"
  assumes sol: "(y solves_ode f) S X"
  assumes v': "(v has_vderiv_on v') S"
  assumes upper: "t. t  S  t > t0  f t (v t) < v' t"
  assumes iv: "y t0  v t0"
  assumes t: "t0  t" "t0  S" "t  S" "is_interval S" "S  T"
  shows "y t  v t"
proof cases
  assume "v t0 = y t0"
  have "{t0 -- t}  S" using t by (simp add: closed_segment_subset is_interval_convex)
  with sol have "(y solves_ode f) {t0 -- t} X" using order_refl by (rule solves_ode_on_subset)
  moreover note refl
  moreover
  have "{t0 -- t}  T" using {t0 -- t}  S S  T by (rule order_trans)
  ultimately have t_ex: "t  existence_ivl t0 (y t0)"
    by (rule existence_ivl_maximal_segment)

  have t0_ex: "t0  existence_ivl t0 (y t0)"
    using in_existence_between_zeroI t_ex by blast
  have "t0  T" using assms(9) t(2) by blast

  from uniform_limit_flow[OF t0_ex t_ex] t0  t
  have "uniform_limit {t0..t} (flow t0) (flow t0 (y t0)) (at (y t0))" by simp
  then have "uniform_limit {t0..t} (flow t0) (flow t0 (y t0)) (at_left (y t0))"
    by (rule uniform_limit_at_within_subset) simp
  moreover
  {
    have "F i in at (y t0). t  existence_ivl t0 i"
      by (rule eventually_mem_existence_ivl) fact
    then have "F i in at_left (y t0). t  existence_ivl t0 i"
      unfolding eventually_at_filter
      by eventually_elim simp
    moreover have "F i in at_left (y t0). i  X"
    proof -
      have f1: "r ra rb. r  existence_ivl ra rb  rb  X"
        by (metis existence_ivl_reverse flow_in_domain flows_reverse)
      obtain rr :: "(real  bool)  (real  bool)  real" where
        "p f pa fa. (¬ eventually p f  eventually pa f  p (rr p pa)) 
          (¬ eventually p fa  ¬ pa (rr p pa)  eventually pa fa)"
        by (metis (no_types) eventually_mono)
      then show ?thesis
        using f1 calculation by meson
    qed
    moreover have "F i in at_left (y t0). i < y t0"
      by (simp add: eventually_at_filter)
    ultimately have "F i in at_left (y t0). x{t0..t}. flow t0 i x  v x"
    proof eventually_elim
      case (elim y')
      show ?case
      proof safe
        fix s assume s: "s  {t0..t}"
        show "flow t0 y' s  v s"
        proof cases
          assume "s = t0" with elim iv show ?thesis
            by (simp add: t0  T y'  X)
        next
          assume "s  t0" with s have "t0 < s" by simp
          have "{t0 -- s}  S" using {t0--t}  S closed_segment_eq_real_ivl s by auto
          from s elim have "{t0..s}  existence_ivl t0 y'"
            using ivl_subset_existence_ivl by blast
          with flow_solves_ode have sol: "(flow t0 y' solves_ode f) {t0 .. s} X"
            by (rule solves_ode_on_subset) (auto intro!: y'  X t0  T)
          have "{t0 .. s}  S" using {t0 -- s}  S by (simp add: closed_segment_eq_real_ivl split: if_splits)
          with v' have v': "(v has_vderiv_on v') {t0 .. s}"
            by (rule has_vderiv_on_subset)
          from y' < y t0 v t0 = y t0 have less_init: "flow t0 y' t0 < v t0"
            by (simp add: flow_initial_time_if t0  T y'  X)
          from strict_upper_solution[OF sol v' upper less_imp_le[OF less_init] _ t0 < s]
            {t0 .. s}  S
            less_init t0 < s
          have "flow t0 y' s < v s" by (simp add: subset_iff is_interval_cc)
          then show ?thesis by simp
        qed
      qed
    qed
  }
  moreover have "t  {t0 .. t}" using t0  t by simp
  ultimately have "flow t0 (y t0) t  v t"
    by (rule uniform_limit_le_const[OF trivial_limit_at_left_real])
  also have "flow t0 (y t0) t = y t"
    using sol t
    by (intro maximal_existence_flow) auto
  finally show ?thesis .
next
  assume "v t0  y t0" then have less: "y t0 < v t0" using iv by simp
  show ?thesis
    apply (cases "t0 = t")
    subgoal using iv by blast
    subgoal using strict_upper_solution[OF sol v' upper iv] less t by force
    done
qed

end

end

Theory Poincare_Map

theory Poincare_Map
imports
  Flow
begin

abbreviation "plane n c  {x. x  n = c}"

lemma
  eventually_tendsto_compose_within:
  assumes "eventually P (at l within S)"
  assumes "P l"
  assumes "(f  l) (at x within T)"
  assumes "eventually (λx. f x  S) (at x within T)"
  shows "eventually (λx. P (f x)) (at x within T)"
proof -
  from assms(1) assms(2) obtain U where U:
    "open U" "l  U" "x. x  U  x  S  P x"
    by (force simp: eventually_at_topological)
  from topological_tendstoD[OF assms(3) ‹open U l  U]
  have "F x in at x within T. f x  U" by auto
  then show ?thesis using assms(4)
    by eventually_elim (auto intro!: U)
qed

lemma
  eventually_eventually_withinI:― ‹aha...›
  assumes "F x in at x within A. P x" "P x"
  shows "F a in at x within S. F x in at a within A. P x"
  using assms
  unfolding eventually_at_topological
  by force

lemma eventually_not_in_closed:
  assumes "closed P"
  assumes "f t  P" "t  T"
  assumes "continuous_on T f"
  shows "F t in at t within T. f t  P"
  using assms
  unfolding Compl_iff[symmetric] closed_def continuous_on_topological eventually_at_topological
  by metis

context ll_on_open_it begin

lemma
  existence_ivl_trans':
  assumes "t + s  existence_ivl t0 x0"
    "t  existence_ivl t0 x0"
  shows "t + s  existence_ivl t (flow t0 x0 t)"
  by (meson assms(1) assms(2) general.existence_ivl_reverse general.flow_solves_ode
      general.is_interval_existence_ivl general.maximal_existence_flow(1)
      general.mem_existence_ivl_iv_defined(2) general.mem_existence_ivl_subset
      local.existence_ivl_subset subsetD)

end

context auto_ll_on_open― ‹TODO: generalize to continuous systems›
begin

definition returns_to ::"'a set  'a  bool"
  where "returns_to P x  (F t in at_right 0. flow0 x t  P)  (t>0. t  existence_ivl0 x  flow0 x t  P)"

definition return_time :: "'a set  'a  real"
  where "return_time P x =
    (if returns_to P x then (SOME t.
      t > 0 
      t  existence_ivl0 x 
      flow0 x t  P 
      (s  {0<..<t}. flow0 x s  P)) else 0)"

lemma returns_toI:
  assumes t: "t > 0" "t  existence_ivl0 x" "flow0 x t  P"
  assumes ev: "F t in at_right 0. flow0 x t  P"
  assumes "closed P"
  shows "returns_to P x"
  using assms
  by (auto simp: returns_to_def)

lemma returns_to_outsideI:
  assumes t: "t  0" "t  existence_ivl0 x" "flow0 x t  P"
  assumes ev: "x  P"
  assumes "closed P"
  shows "returns_to P x"
proof cases
  assume "t > 0"
  moreover
  have "F s in at 0 within {0 .. t}. flow0 x s  P"
    using assms mem_existence_ivl_iv_defined ivl_subset_existence_ivl[OF t  _] 0 < t
    by (auto intro!: eventually_not_in_closed flow_continuous_on continuous_intros
        simp: eventually_conj_iff)
  with order_tendstoD(2)[OF tendsto_ident_at 0 < t, of "{0<..}"]
  have "F t in at_right 0. flow0 x t  P"
    unfolding eventually_at_filter
    by eventually_elim (use t > 0 in auto)
  then show ?thesis
    by (auto intro!: returns_toI assms 0 < t)
qed (use assms in simp)

lemma returns_toE:
  assumes "returns_to P x"
  obtains t0 t1 where
    "0 < t0"
    "t0  t1"
    "t1  existence_ivl0 x"
    "flow0 x t1  P"
    "t. 0 < t  t < t0  flow0 x t  P"
proof -
  obtain t0 t1 where t0: "t0 > 0" "t. 0 < t  t < t0  flow0 x t  P"
    and t1: "t1 > 0" "t1  existence_ivl0 x" "flow0 x t1  P"
    using assms
    by (auto simp: returns_to_def eventually_at_right[OF zero_less_one])
  moreover
  have "t0  t1"
    using t0(2)[of t1] t1 t0(1)
    by force
  ultimately show ?thesis by (blast intro: that)
qed

lemma return_time_some:
  assumes "returns_to P x"
  shows "return_time P x =
    (SOME t. t > 0  t  existence_ivl0 x  flow0 x t  P  (s  {0<..<t}. flow0 x s  P))"
  using assms by (auto simp: return_time_def)

lemma return_time_ex1:
  assumes "returns_to P x"
  assumes "closed P"
  shows "∃!t. t > 0  t  existence_ivl0 x  flow0 x t  P  (s  {0<..<t}. flow0 x s  P)"
proof -
  from returns_toE[OF ‹returns_to P x]
  obtain t0 t1 where
    t1: "t1  t0" "t1  existence_ivl0 x" "flow0 x t1  P"
    and t0: "t0 > 0" "t. 0 < t  t < t0  flow0 x t  P"
    by metis
  from flow_continuous_on have cont: "continuous_on {0 .. t1} (flow0 x)"
    by (rule continuous_on_subset) (intro ivl_subset_existence_ivl t1)
  from cont have cont': "continuous_on {t0 .. t1} (flow0 x)"
    by (rule continuous_on_subset) (use 0 < t0 in auto)
  have "compact (flow0 x -` P  {t0 .. t1})"
    using ‹closed P cont'
    by (auto simp: compact_eq_bounded_closed bounded_Int bounded_closed_interval
        intro!: closed_vimage_Int)

  have "flow0 x -` P  {t0..t1}  {}"
    using t1 t0 by auto
  from compact_attains_inf[OF ‹compact _ this] t0 t1
  obtain rt where rt: "t0  rt" "rt  t1" "flow0 x rt  P"
    and least: "t'. flow0 x t'  P  t0  t'  t'  t1  rt  t'"
    by auto
  have "0 < rt" "flow0 x rt  P" "rt  existence_ivl0 x"
    and "0 < t'  t' < rt  flow0 x t'  P" for t'
    using ivl_subset_existence_ivl[OF t1  existence_ivl0 x] t0 t1 rt least[of t']
    by force+
  then show ?thesis
    by (intro ex_ex1I) force+
qed

lemma
  return_time_pos_returns_to:
  "return_time P x > 0  returns_to P x"
  by (auto simp: return_time_def split: if_splits)

lemma
  assumes ret: "returns_to P x"
  assumes "closed P"
  shows return_time_pos: "return_time P x > 0"
  using someI_ex[OF return_time_ex1[OF assms, THEN ex1_implies_ex]]
  unfolding return_time_some[OF ret, symmetric]
  by auto

lemma returns_to_return_time_pos:
  assumes "closed P"
  shows "returns_to P x  return_time P x > 0"
  by (auto intro!: return_time_pos assms) (auto simp: return_time_def split: if_splits)

lemma return_time:
  assumes ret: "returns_to P x"
  assumes "closed P"
  shows "return_time P x > 0"
    and return_time_exivl: "return_time P x  existence_ivl0 x"
    and return_time_returns: "flow0 x (return_time P x)  P"
    and return_time_least: "s. 0 < s  s < return_time P x  flow0 x s  P"
  using someI_ex[OF return_time_ex1[OF assms, THEN ex1_implies_ex]]
  unfolding return_time_some[OF ret, symmetric]
  by auto

lemma returns_to_earlierI:
  assumes ret: "returns_to P (flow0 x t)" "closed P"
  assumes "t  0" "t  existence_ivl0 x"
  assumes ev: "F t in at_right 0. flow0 x t  P"
  shows "returns_to P x"
proof -
  from return_time[OF ret]
  have rt: "0 < return_time P (flow0 x t)" "flow0 (flow0 x t) (return_time P (flow0 x t))  P"
    and "0 < s  s < return_time P (flow0 x t)  flow0 (flow0 x t) s  P" for s
    by auto
  let ?t = "t + return_time P  (flow0 x t)"
  show ?thesis
  proof (rule returns_toI[of ?t])
    show "0 < ?t" by (auto intro!: add_nonneg_pos rt t  0)
    show "?t  existence_ivl0 x"
      by (intro existence_ivl_trans return_time_exivl assms)
    have "flow0 x (t + return_time P (flow0 x t)) = flow0 (flow0 x t) (return_time P (flow0 x t))"
      by (intro flow_trans assms return_time_exivl)
    also have "  P"
      by (rule return_time_returns[OF ret])
    finally show "flow0 x (t + return_time P (flow0 x t))  P" .
    show "closed P" by fact
    show "F t in at_right 0. flow0 x t  P" by fact
  qed
qed

lemma return_time_gt:
  assumes ret: "returns_to P x" "closed P"
  assumes flow_not: "s. 0 < s  s  t  flow0 x s  P"
  shows "t < return_time P x"
  using flow_not[of "return_time P x"] return_time_pos[OF ret] return_time_returns[OF ret] by force

lemma return_time_le:
  assumes ret: "returns_to P x" "closed P"
  assumes flow_not: "flow0 x t  P" "t > 0"
  shows "return_time P x  t"
  using return_time_least[OF assms(1,2), of t] flow_not
  by force

lemma returns_to_laterI:
  assumes ret: "returns_to P x" "closed P"
  assumes t: "t > 0" "t  existence_ivl0 x"
  assumes flow_not: "s. 0 < s  s  t  flow0 x s  P"
  shows "returns_to P (flow0 x t)"
  apply (rule returns_toI[of "return_time P x - t"])
  subgoal using flow_not by (auto intro!: return_time_gt ret)
  subgoal by (auto intro!: existence_ivl_trans' return_time_exivl ret t)
  subgoal by (subst flow_trans[symmetric])
      (auto intro!: existence_ivl_trans' return_time_exivl ret t return_time_returns)
  subgoal
  proof -
    have "F y in nhds 0. y  existence_ivl0 (flow0 x t)"
      apply (rule eventually_nhds_in_open[OF open_existence_ivl[of "flow0 x t"] existence_ivl_zero])
      apply (rule flow_in_domain)
      apply fact
      done
    then have "F s in at_right 0. s  existence_ivl0 (flow0 x t)"
      unfolding eventually_at_filter
      by eventually_elim auto
    moreover
    have "F s in at_right 0. t + s < return_time P x"
      using return_time_gt[OF ret flow_not, of t]
      by (auto simp: eventually_at_right[OF zero_less_one] intro!: exI[of _ "return_time P x - t"])
    moreover
    have "F s in at_right 0. 0 < t + s"
      by (metis (mono_tags) eventually_at_rightI greaterThanLessThan_iff pos_add_strict t(1))
    ultimately show ?thesis
      apply eventually_elim
      apply (subst flow_trans[symmetric])
      using return_time_least[OF ret]
      by (auto intro!: existence_ivl_trans' t)
    qed
  subgoal by fact
  done

lemma never_returns:
  assumes "¬returns_to P x"
  assumes "closed P" "t  0" "t  existence_ivl0 x"
  assumes ev: "F t in at_right 0. flow0 x t  P"
  shows "¬returns_to P (flow0 x t)"
  using returns_to_earlierI[OF _ assms(2-5)] assms(1)
  by blast

lemma return_time_eqI:
  assumes "closed P"
    and t_pos: "t > 0"
    and ex: "t  existence_ivl0 x"
    and ret: "flow0 x t  P"
    and least: "s. 0 < s  s < t  flow0 x s  P"
  shows "return_time P x = t"
proof -
  from least t_pos have "F t in at_right 0. flow0 x t  P"
    by (auto simp: eventually_at_right[OF zero_less_one])
  then have "returns_to P x"
    by (auto intro!: returns_toI[of t] assms)
  then show ?thesis
    using least
    by (auto simp: return_time_def t_pos ex ret
        intro!: some1_equality[OF return_time_ex1[OF ‹returns_to _ _ ‹closed _]])
qed

lemma return_time_step:
  assumes "returns_to P (flow0 x t)"
  assumes "closed P"
  assumes flow_not: "s. 0 < s  s  t  flow0 x s  P"
  assumes t: "t > 0" "t  existence_ivl0 x"
  shows "return_time P (flow0 x t) = return_time P x - t"
proof -
  from flow_not t have "F t in at_right 0. flow0 x t  P"
    by (auto simp: eventually_at_right[OF zero_less_one])
  from returns_to_earlierI[OF assms(1,2) less_imp_le, OF t this]
  have ret: "returns_to P x" .
  from return_time_gt[OF ret ‹closed P flow_not]
  have "t < return_time P x" by simp
  moreover
  have "0 < s  s < return_time P x - t  flow0 (flow0 x t) s = flow0 x (t + s)" for s
    using ivl_subset_existence_ivl[OF return_time_exivl[OF ret ‹closed _]] t
    by (subst flow_trans) (auto intro!: existence_ivl_trans')
  ultimately show ?thesis
    using flow_not assms(1) ret return_time_least t(1)
    by (auto intro!: return_time_eqI return_time_returns ret
        simp: flow_trans[symmetric] ‹closed P t(2) existence_ivl_trans' return_time_exivl)
qed

definition "poincare_map P x = flow0 x (return_time P x)"

lemma poincare_map_step_flow:
  assumes ret: "returns_to P x" "closed P"
  assumes flow_not: "s. 0 < s  s  t  flow0 x s  P"
  assumes t: "t > 0" "t  existence_ivl0 x"
  shows "poincare_map P (flow0 x t) = poincare_map P x"
  unfolding poincare_map_def
  apply (subst flow_trans[symmetric])
  subgoal by fact
  subgoal using flow_not by (auto intro!: return_time_exivl returns_to_laterI t ret)
  subgoal
    using flow_not
    by (subst return_time_step) (auto intro!: return_time_exivl returns_to_laterI t ret)
  done

lemma poincare_map_returns:
  assumes "returns_to P x" "closed P"
  shows "poincare_map P x  P"
  by (auto intro!: return_time_returns assms simp: poincare_map_def)

lemma poincare_map_onto:
  assumes "closed P"
  assumes "0 < t" "t  existence_ivl0 x" "F t in at_right 0. flow0 x t  P"
  assumes "flow0 x t  P"
  shows "poincare_map P x  flow0 x ` {0 <.. t}  P"
proof (rule IntI)
  have "returns_to P x"
    by (rule returns_toI) (rule assms)+
  then have "return_time P x  {0<..t}"
    by (auto intro!: return_time_pos assms return_time_le)
  then show "poincare_map P x  flow0 x ` {0<..t}"
    by (auto simp: poincare_map_def)
  show "poincare_map P x  P"
    by (auto intro!: poincare_map_returns ‹returns_to _ _ ‹closed _)
qed

end


lemma isCont_blinfunD:
  fixes f'::"'a::metric_space  'b::real_normed_vector L 'c::real_normed_vector"
  assumes "isCont f' a" "0 < e"
  shows "d>0. x. dist a x < d  onorm (λv. blinfun_apply (f' x) v - blinfun_apply (f' a) v) < e"
proof -
  have "F x in at a. dist (f' x) (f' a) < e"
    using assms isCont_def tendsto_iff by blast
  then show ?thesis
    using e > 0 norm_eq_zero
    by (force simp: eventually_at dist_commute dist_norm norm_blinfun.rep_eq
        simp flip: blinfun.bilinear_simps)
qed

proposition has_derivative_locally_injective_blinfun:
  fixes f :: "'n::euclidean_space  'm::euclidean_space"
    and f'::"'n  'n L 'm"
    and g'::"'m L 'n"
  assumes "a  s"
      and "open s"
      and g': "g' oL (f' a) = 1L"
      and f': "x. x  s  (f has_derivative f' x) (at x)"
      and c: "isCont f' a"
    obtains r where "r > 0" "ball a r  s" "inj_on f (ball a r)"
proof -
  have bl: "bounded_linear (blinfun_apply g')"
    by (auto simp: blinfun.bounded_linear_right)
  from g' have g': "blinfun_apply g'  blinfun_apply (f' a) = id"
    by transfer (simp add: id_def)
  from has_derivative_locally_injective[OF a  s ‹open s bl g' f' isCont_blinfunD[OF c]]
  obtain r where "0 < r" "ball a r  s" "inj_on f (ball a r)"
    by auto
  then show ?thesis ..
qed

lift_definition embed1_blinfun::"'a::real_normed_vector L ('a*'b::real_normed_vector)" is "λx. (x, 0)"
  by standard (auto intro!: exI[where x=1])
lemma blinfun_apply_embed1_blinfun[simp]: "blinfun_apply embed1_blinfun x = (x, 0)"
  by transfer simp

lift_definition embed2_blinfun::"'a::real_normed_vector L ('b::real_normed_vector*'a)" is "λx. (0, x)"
  by standard (auto intro!: exI[where x=1])
lemma blinfun_apply_embed2_blinfun[simp]: "blinfun_apply embed2_blinfun x = (0, x)"
  by transfer simp

lemma blinfun_inverseD: "f oL f' = 1L  f (f' x) = x"
  apply transfer
  unfolding o_def
  by meson

lemmas continuous_on_open_vimageI = continuous_on_open_vimage[THEN iffD1, rule_format]
lemmas continuous_on_closed_vimageI = continuous_on_closed_vimage[THEN iffD1, rule_format]

lemma ball_times_subset: "ball a (c/2) × ball b (c/2)  ball (a, b) c"
proof -
  {
    fix a' b'
    have "sqrt ((dist a a')2 + (dist b b')2)  dist a a' + dist b b'"
      by (rule real_le_lsqrt) (auto simp: power2_eq_square algebra_simps)
    also assume "a'  ball a (c / 2)"
    then have "dist a a' < c / 2" by (simp add:)
    also assume "b'  ball b (c / 2)"
    then have "dist b b' < c / 2" by (simp add:)
    finally have "sqrt ((dist a a')2 + (dist b b')2) < c"
      by simp
  } thus ?thesis by (auto simp: dist_prod_def mem_cball)
qed

lemma linear_inverse_blinop_lemma:
  fixes w::"'a::{banach, perfect_space} blinop"
  assumes "norm w < 1"
  shows
    "summable (λn. (-1)^n *R w^n)" (is ?C)
    "(n. (-1)^n *R w^n) * (1 + w) = 1" (is ?I1)
    "(1 + w) * (n. (-1)^n *R w^n) = 1" (is ?I2)
    "norm ((n. (-1)^n *R w^n) - 1 + w)  (norm w)2/(1 - norm (w))" (is ?L)
proof -
  have "summable (λn. norm w ^ n)"
    apply (rule summable_geometric)
    using assms by auto
  then have "summable (λn. norm (w ^ n))"
    by (rule summable_comparison_test'[where N=0]) (auto intro!: norm_power_ineq)
  then show ?C
    by (rule summable_comparison_test'[where N=0]) (auto simp: norm_power )
  {
    fix N
    have 1: "(1 + w) * sum (λn. (-1)^n *R w^n) {..<N} = sum (λn. (-1)^n *R w^n) {..<N} * (1 + w)"
      by (auto simp: algebra_simps sum_distrib_left sum_distrib_right sum.distrib power_commutes)
    also have " = sum (λn. (-1)^n *R w^n - (-1)^Suc n *R w^ Suc n) {..<N}"
      by (auto simp: algebra_simps sum_distrib_left sum_distrib_right sum.distrib power_commutes)
    also have " = 1 - (-1)^N *R w^N"
      by (subst sum_lessThan_telescope') (auto simp: algebra_simps)
    finally have "(1 + w) * (n<N. (- 1) ^ n *R w ^ n) = 1 - (- 1) ^ N *R w ^ N" .
    note 1 this
  } note nu = this
  show "?I1"
    apply (subst suminf_mult2, fact)
    apply (subst suminf_eq_lim)
    apply (subst sum_distrib_right[symmetric])
    apply (rule limI)
    apply (subst nu(1)[symmetric])
    apply (subst nu(2))
    apply (rule tendsto_eq_intros)
      apply (rule tendsto_intros)
     apply (rule tendsto_norm_zero_cancel)
     apply auto
    apply (rule Lim_transform_bound[where g="λi. norm w ^ i"])
     apply (rule eventuallyI)
    apply simp apply (rule norm_power_ineq)
    apply (auto intro!: LIMSEQ_power_zero assms)
    done
  show "?I2"
    apply (subst suminf_mult[symmetric], fact)
    apply (subst suminf_eq_lim)
    apply (subst sum_distrib_left[symmetric])
    apply (rule limI)
    apply (subst nu(2))
    apply (rule tendsto_eq_intros)
      apply (rule tendsto_intros)
     apply (rule tendsto_norm_zero_cancel)
     apply auto
    apply (rule Lim_transform_bound[where g="λi. norm w ^ i"])
     apply (rule eventuallyI)
    apply simp apply (rule norm_power_ineq)
    apply (auto intro!: LIMSEQ_power_zero assms)
    done
  have *: "(n. (- 1) ^ n *R w ^ n) - 1 + w = (w2 * (n. (- 1) ^ n *R w ^ n))"
    apply (subst suminf_split_initial_segment[where k=2], fact)
    apply (subst suminf_mult[symmetric], fact)
    by (auto simp: power2_eq_square algebra_simps eval_nat_numeral)
  also have "norm   (norm w)2 / (1 - norm w)"
  proof -
    have §: "norm (n. (- 1) ^ n *R w ^ n)  1 / (1 - norm w)"
      apply (rule order_trans[OF summable_norm])
       apply auto
       apply fact
      apply (rule order_trans[OF suminf_le])
         apply (rule norm_power_ineq)
        apply fact
       apply fact
      by (auto simp: suminf_geometric assms)
    show ?thesis
      apply (rule order_trans[OF norm_mult_ineq])
      apply (subst divide_inverse)
      apply (rule mult_mono)
         apply (auto simp: norm_power_ineq inverse_eq_divide assms §)
      done
  qed
  finally show ?L .
qed

lemma linear_inverse_blinfun_lemma:
  fixes w::"'a L 'a::{banach, perfect_space}"
  assumes "norm w < 1"
  obtains I where
    "I oL (1L + w) = 1L" "(1L + w) oL I = 1L"
    "norm (I - 1L + w)  (norm w)2/(1 - norm (w))"
proof -
  define v::"'a blinop" where "v = Blinop w"
  have "norm v = norm w"
    unfolding v_def
    apply transfer
    by (simp add: bounded_linear_Blinfun_apply norm_blinfun.rep_eq)
  with assms have "norm v < 1" by simp
  from linear_inverse_blinop_lemma[OF this]
  have v: "(n. (- 1) ^ n *R v ^ n) * (1 + v) = 1"
    "(1 + v) * (n. (- 1) ^ n *R v ^ n) = 1"
    "norm ((n. (- 1) ^ n *R v ^ n) - 1 + v)  (norm v)2 / (1 - norm v)"
    by auto
  define J::"'a blinop" where "J = (n. (- 1) ^ n *R v ^ n)"
  define I::"'a L 'a" where "I = Blinfun J"
  have "Blinfun (blinop_apply J) - 1L + w = Rep_blinop (J - 1 + Blinop (blinfun_apply w))"
    by transfer' (auto simp: blinfun_apply_inverse)
  then have ne: "norm (Blinfun (blinop_apply J) - 1L + w) =
    norm (J - 1 + Blinop (blinfun_apply w))"
    by (auto simp: norm_blinfun_def norm_blinop_def)
  from v have
    "I oL (1L + w) = 1L" "(1L + w) oL I = 1L"
    "norm (I - 1L + w)  (norm w)2/(1 - norm (w))"
      apply (auto simp: I_def J_def[symmetric])
    unfolding v_def
      apply (auto simp: blinop.bounded_linear_right bounded_linear_Blinfun_apply
        intro!: blinfun_eqI)
    subgoal by transfer
       (auto simp: blinfun_ext blinfun.bilinear_simps bounded_linear_Blinfun_apply)
    subgoal
      by transfer (auto simp: Transfer.Rel_def
          blinfun_ext blinfun.bilinear_simps bounded_linear_Blinfun_apply)
    subgoal
      apply (auto simp: ne)
      apply transfer
      by (auto simp: norm_blinfun_def bounded_linear_Blinfun_apply)
    done
  then show ?thesis ..
qed

definition "invertibles_blinfun = {w. wi. w oL wi = 1L  wi oL w = 1L}"

lemma blinfun_inverse_open:― ‹8.3.2 in Dieudonne, TODO: add continuity and derivative›
  shows "open (invertibles_blinfun::
      ('a::{banach, perfect_space} L 'b::banach) set)"
proof (rule openI)
  fix u0::"'a L 'b"
  assume "u0  invertibles_blinfun"
  then obtain u0i where u0i: "u0 oL u0i = 1L" "u0i oL u0 = 1L"
    by (auto simp: invertibles_blinfun_def)
  then have [simp]: "u0i  0"
    apply (auto)
    by (metis one_blinop.abs_eq zero_blinop.abs_eq zero_neq_one)
  let ?e = "inverse (norm u0i)"
  show "e>0. ball u0 e  invertibles_blinfun"
    apply (clarsimp intro!: exI[where x = ?e] simp: invertibles_blinfun_def)
    subgoal premises prems for u0s
    proof -
      define s where "s = u0s - u0"
      have u0s: "u0s = u0 + s"
        by (auto simp: s_def)
      have "norm (u0i oL s) < 1"
        using prems by (auto simp: dist_norm u0s
        divide_simps ac_simps intro!: le_less_trans[OF norm_blinfun_compose])
      from linear_inverse_blinfun_lemma[OF this]
      obtain I where I:
        "I oL 1L + (u0i oL s) = 1L"
        "1L + (u0i oL s) oL I = 1L"
        "norm (I - 1L + (u0i oL s))  (norm (u0i oL s))2 / (1 - norm (u0i oL s))"
        by auto
      have u0s_eq: "u0s = u0 oL (1L + (u0i oL s))"
        using u0i
        by (auto simp: s_def blinfun.bilinear_simps blinfun_ext)
      show ?thesis
        apply (rule exI[where x="I oL u0i"])
        using I u0i
        apply (auto simp: u0s_eq)
        by (auto simp:  algebra_simps blinfun_ext blinfun.bilinear_simps)
    qed
    done
  qed

lemma blinfun_compose_assoc[ac_simps]: "a oL b oL c = a oL (b oL c)"
  by (auto intro!: blinfun_eqI)

text ‹TODO: move @{thm norm_minus_cancel} to class!›
lemma (in real_normed_vector) norm_minus_cancel [simp]: "norm (- x) = norm x"
proof -
  have scaleR_minus_left: "- a *R x = - (a *R x)" for a x
  proof -
    have "x1 x2. (x2::real) + x1 = x1 + x2"
      by auto
    then have f1: "r ra a. (ra + r) *R (a::'a) = r *R a + ra *R a"
      using local.scaleR_add_left by presburger
    have f2: "a + a = 2 * a"
      by force
    have f3: "2 * a + - 1 * a = a"
      by auto
    have "- a = - 1 * a"
      by auto
    then show ?thesis
      using f3 f2 f1 by (metis local.add_minus_cancel local.add_right_imp_eq)
  qed
  have "norm (- x) = norm (scaleR (- 1) x)"
    by (simp only: scaleR_minus_left scaleR_one)
  also have " = ¦- 1¦ * norm x"
    by (rule norm_scaleR)
  finally show ?thesis by simp
qed

text ‹TODO: move @{thm norm_minus_commute} to class!›
lemma (in real_normed_vector) norm_minus_commute: "norm (a - b) = norm (b - a)"
proof -
  have "norm (- (b - a)) = norm (b - a)"
    by (rule norm_minus_cancel)
  then show ?thesis by simp
qed

instance euclidean_space  banach
  by standard

lemma blinfun_apply_Pair_split:
  "blinfun_apply g (a, b) = blinfun_apply g (a, 0) + blinfun_apply g (0, b)"
  unfolding blinfun.bilinear_simps[symmetric] by simp

lemma blinfun_apply_Pair_add2: "blinfun_apply f (0, a + b) = blinfun_apply f (0, a) + blinfun_apply f (0, b)"
  unfolding blinfun.bilinear_simps[symmetric] by simp

lemma blinfun_apply_Pair_add1: "blinfun_apply f (a + b, 0) = blinfun_apply f (a, 0) + blinfun_apply f (b, 0)"
  unfolding blinfun.bilinear_simps[symmetric] by simp

lemma blinfun_apply_Pair_minus2: "blinfun_apply f (0, a - b) = blinfun_apply f (0, a) - blinfun_apply f (0, b)"
  unfolding blinfun.bilinear_simps[symmetric] by simp

lemma blinfun_apply_Pair_minus1: "blinfun_apply f (a - b, 0) = blinfun_apply f (a, 0) - blinfun_apply f (b, 0)"
  unfolding blinfun.bilinear_simps[symmetric] by simp

lemma implicit_function_theorem:
  fixes f::"'a::euclidean_space * 'b::euclidean_space  'c::euclidean_space"― ‹TODO: generalize?!›
  assumes [derivative_intros]: "x. x  S  (f has_derivative blinfun_apply (f' x)) (at x)"
  assumes S: "(x, y)  S" "open S"
  assumes "DIM('c)  DIM('b)"
  assumes f'C: "isCont f' (x, y)"
  assumes "f (x, y) = 0"
  assumes T2: "T oL (f' (x, y) oL embed2_blinfun) = 1L"
  assumes T1: "(f' (x, y) oL embed2_blinfun) oL T = 1L"― ‹TODO: reduce?!›
  obtains u e r
  where "f (x, u x) = 0" "u x = y"
    "s. s  cball x e  f (s, u s) = 0"
    "continuous_on (cball x e) u"
    "(λt. (t, u t)) ` cball x e  S"
    "e > 0"
    "(u has_derivative - T oL f' (x, y) oL embed1_blinfun) (at x)"

    "r > 0"
    "U v s. v x = y  (s. s  U  f (s, v s) = 0)  U  cball x e 
      continuous_on U v  s  U  (s, v s)  ball (x, y) r  u s = v s"
proof -
  define H where "H  λ(x, y). (x, f (x, y))"
  define H' where "H'  λx. (embed1_blinfun oL fst_blinfun) + (embed2_blinfun oL (f' x))"
  have f'_inv: "f' (x, y) oL embed2_blinfun  invertibles_blinfun"
    using T1 T2 by (auto simp: invertibles_blinfun_def ac_simps intro!: exI[where x=T])
  from openE[OF blinfun_inverse_open this]
  obtain d0 where e0: "0 < d0"
    "ball (f' (x, y) oL embed2_blinfun) d0  invertibles_blinfun"
    by auto
  have "isCont (λs. f' s oL embed2_blinfun) (x, y)"
    by (auto intro!: continuous_intros f'C)
  from this[unfolded isCont_def, THEN tendstoD, OF 0 < d0]
  have "F s in at (x, y). f' s oL embed2_blinfun  invertibles_blinfun"
    apply eventually_elim
    using e0 by (auto simp: subset_iff dist_commute)
  then obtain e0 where "e0 > 0"
      "xa  (x, y)  dist xa (x, y) < e0 
        f' xa oL embed2_blinfun  invertibles_blinfun" for xa
    unfolding eventually_at
    by auto
  then have e0: "e0 > 0"
    "dist xa (x, y) < e0  f' xa oL embed2_blinfun  invertibles_blinfun" for xa
    apply -
    subgoal by simp
    using f'_inv
    apply (cases "xa = (x, y)")
    by auto

  have H': "x  S  (H has_derivative H' x) (at x)" for x
    unfolding H_def  H'_def
    by (auto intro!: derivative_eq_intros ext simp: blinfun.bilinear_simps)
  have cH': "isCont H' (x, y)"
    unfolding H'_def
    by (auto intro!: continuous_intros assms)
  have linear_H': "s. s  S  linear (H' s)"
    using H' assms(2) has_derivative_linear by blast
  have *: "blinfun_apply T (blinfun_apply (f' (x, y)) (0, b)) = b" for b
    using blinfun_inverseD[OF T2, of b]
    by simp
  have "inj (f' (x, y) oL embed2_blinfun)"
    by (metis (no_types, lifting) "*" blinfun_apply_blinfun_compose embed2_blinfun.rep_eq injI)
  then have [simp]: "blinfun_apply (f' (x, y)) (0, b) = 0  b = 0" for b
    apply (subst (asm) linear_injective_0)
    subgoal
      apply (rule bounded_linear.linear)
      apply (rule blinfun.bounded_linear_right)
      done
    subgoal by simp
    done
  have "inj (H' (x, y))"
    apply (subst linear_injective_0)
     apply (rule linear_H')
     apply fact
    apply (auto simp: H'_def blinfun.bilinear_simps zero_prod_def)
    done
  define Hi where "Hi = (embed1_blinfun oL fst_blinfun) + ((embed2_blinfun oL T oL (snd_blinfun - (f' (x, y) oL embed1_blinfun oL fst_blinfun))))"
  have Hi': "(λu. snd (blinfun_apply Hi (u, 0))) = - T oL f' (x, y) oL embed1_blinfun"
    by (auto simp: Hi_def blinfun.bilinear_simps)
  have Hi: "Hi oL H' (x, y) = 1L"
    apply (auto simp: H'_def fun_eq_iff blinfun.bilinear_simps Hi_def
        intro!: ext blinfun_eqI)
    apply (subst blinfun_apply_Pair_split)
    by (auto simp: * blinfun.bilinear_simps)
  from has_derivative_locally_injective_blinfun[OF S this H' cH']
  obtain r0 where r0: "0 < r0" "ball (x, y) r0  S" and inj: "inj_on H (ball (x, y) r0)"
    by auto
  define r where "r = min r0 e0"
  have r: "0 < r" "ball (x, y) r  S" and inj: "inj_on H (ball (x, y) r)"
    and r_inv: "s. s  ball (x, y) r  f' s oL embed2_blinfun  invertibles_blinfun"
    subgoal using e0 r0 by (auto simp: r_def)
    subgoal using e0 r0 by (auto simp: r_def)
    subgoal using inj apply (rule inj_on_subset)
      using e0 r0 by (auto simp: r_def)
    subgoal for s
      using e0 r0 by (auto simp: r_def dist_commute)
    done
  obtain i::'a where "i  Basis"
    using nonempty_Basis by blast
  define undef where "undef  (x, y) + r *R (i, 0)"― ‹really??›
  have ud: "¬ dist (x, y) undef < r"
    using r > 0 i  Basis› by (auto simp: undef_def dist_norm)
  define G where "G  the_inv_into (ball (x, y) r) H"
  {
    fix u v
    assume [simp]: "(u, v)  H ` ball (x, y) r"
    note [simp] = inj
    have "(u, v) = H (G (u, v))"
      unfolding G_def
      by (subst f_the_inv_into_f[where f=H]) auto
    moreover have " = H (G (u, v))"
      by (auto simp: G_def)
    moreover have " = (fst (G (u, v)), f (G (u, v)))"
      by (auto simp: H_def split_beta')
    ultimately have "u = fst (G (u, v))" "v = f (G (u, v))" by simp_all
    then have "f (u, snd (G(u, v))) = v" "u = fst (G (u, v))"
      by (metis prod.collapse)+
  } note uvs = this
  note uv = uvs(1)
  moreover
  have "f (x, snd (G (x, 0))) = 0"
    apply (rule uv)
    by (metis (mono_tags, lifting) H_def assms(6) case_prod_beta' centre_in_ball fst_conv image_iff r(1) snd_conv)
  moreover
  have cH: "continuous_on S H"
    apply (rule has_derivative_continuous_on)
    apply (subst at_within_open)
      apply (auto intro!: H' assms)
    done
  have inj2: "inj_on H (ball (x, y) (r / 2))"
    apply (rule inj_on_subset, rule inj)
    using r by auto
  have oH: "open (H ` ball (x, y) (r/2))"
    apply (rule invariance_of_domain_gen)
       apply (auto simp: assms inj)
    apply (rule continuous_on_subset)
      apply fact
    using r
     apply auto
    using inj2 apply simp
    done
  have "(x, f (x, y))  H ` ball (x, y) (r/2)"
    using r > 0 by (auto simp: H_def)
  from open_contains_cball[THEN iffD1, OF oH, rule_format, OF this]
  obtain e' where e': "e' > 0" "cball (x, f (x, y)) e'  H ` ball (x, y) (r/2)"
    by auto

  have inv_subset: "the_inv_into (ball (x, y) r) H a = the_inv_into R H a"
    if "a  H ` R" "R  (ball (x, y) r)"
    for a R
    apply (rule the_inv_into_f_eq[OF inj])
     apply (rule f_the_inv_into_f)
      apply (rule inj_on_subset[OF inj])
      apply fact
     apply fact
    apply (rule the_inv_into_into)
      apply (rule inj_on_subset[OF inj])
      apply fact
     apply fact
    apply (rule order_trans)
     apply fact
    using r apply auto
    done
  have GH: "G (H z) = z" if "dist (x, y) z < r" for z
    by (auto simp: G_def the_inv_into_f_f inj that)
  define e where "e = min (e' / 2) e0"
  define r2 where "r2 = r / 2"
  have r2: "r2 > 0" "r2 < r"
    using r > 0 by (auto simp: r2_def)
  have "e > 0" using e' e0 by (auto simp: e_def)
  from cball_times_subset[of "x" e' "f (x, y)"] e'
  have "cball x e × cball (f (x, y)) e  H ` ball (x, y) (r/2)"
    by (force simp: e_def)
  then have e_r_subset: "z  cball x e  (z, 0)  H ` ball (x, y) (r/2)" for z
    using 0 < e assms(6)
    by (auto simp: H_def subset_iff)
  have u0: "(u, 0)  H ` ball (x, y) r" if "u  cball x e" for u
    apply (rule rev_subsetD)
     apply (rule e_r_subset)
     apply fact
    unfolding r2_def using r2 by auto
  have G_r: "G (u, 0)  ball (x, y) r" if "u  cball x e" for u
    unfolding G_def
    apply (rule the_inv_into_into)
      apply fact
     apply (auto)
    apply (rule u0, fact)
    done
  note e_r_subset
  ultimately have G2:
    "f (x, snd (G (x, 0))) = 0" "snd (G (x, 0)) = y"
    "u. u  cball x e  f (u, snd (G (u, 0))) = 0"
    "continuous_on (cball x e) (λu. snd (G (u, 0)))"
    "(λt. (t, snd (G (t, 0)))) ` cball x e  S"
    "e > 0"
    "((λu. snd (G (u, 0))) has_derivative (λu. snd (Hi (u, 0)))) (at x)"
       apply (auto simp: G_def split_beta'
        intro!: continuous_intros continuous_on_compose2[OF cH])
    subgoal premises prems
    proof -
      have "the_inv_into (ball (x, y) r) H (x, 0) = (x, y)"
        apply (rule the_inv_into_f_eq)
          apply fact
         by (auto simp: H_def assms r > 0)
       then show ?thesis
         by auto
    qed
    using r2(2) r2_def apply fastforce
    apply (subst continuous_on_cong[OF refl])
     apply (rule inv_subset[where R="cball (x, y) r2"])
    subgoal
      using r2
      apply auto
      using r2_def by force
    subgoal using r2 by (force simp:)
    subgoal
      apply (rule continuous_on_compose2[OF continuous_on_inv_into])
      using r(2) r2(2)
        apply (auto simp: r2_def[symmetric]
          intro!: continuous_on_compose2[OF cH] continuous_intros)
       apply (rule inj_on_subset)
        apply (rule inj)
      using r(2) r2(2) apply force
      apply force
      done
    subgoal premises prems for u
    proof -
      from prems have u: "u  cball x e" by auto
      note G_r[OF u]
      also have "ball (x, y) r  S"
        using r by simp
      finally have "(G (u, 0))  S" .
      then show ?thesis
        unfolding G_def[symmetric]
        using uvs(2)[OF u0, OF u]
        by (metis prod.collapse)
    qed
    subgoal using e > 0 by simp
    subgoal premises prems
    proof -
      have "(x, y)  cball (x, y) r2"
        using r2
        by auto
      moreover
      have "H (x, y)  interior (H ` cball (x, y) r2)"
        apply (rule interiorI[OF oH])
        using r2 by (auto simp: r2_def)
      moreover
      have "cball (x, y) r2  S"
        using r r2 by auto
      moreover have "z. z  cball (x, y) r2  G (H z) = z"
        using r2 by (auto intro!: GH)
      ultimately have "(G has_derivative Hi) (at (H (x, y)))"
      proof (rule has_derivative_inverse[where g = G and f = H,
              OF compact_cball _ _ continuous_on_subset[OF cH] _ H' _ _])
        show "blinfun_apply Hi  blinfun_apply (H' (x, y)) = id"
          using Hi by transfer auto
      qed (use S blinfun.bounded_linear_right in auto)
      then have g': "(G has_derivative Hi) (at (x, 0))"
        by (auto simp: H_def assms)
      show ?thesis
        unfolding G_def[symmetric] H_def[symmetric]
        apply (auto intro!: derivative_eq_intros)
         apply (rule has_derivative_compose[where g=G and f="λx. (x, 0)"])
         apply (auto intro!: g' derivative_eq_intros)
        done
    qed
    done
  moreover
  note r > 0
  moreover
  define u where "u  λx. snd (G (x, 0))"
  have local_unique: "u s = v s"
    if solves: "(s. s  U  f (s, v s) = 0)"
    and i: "v x = y"
    and v: "continuous_on U v"
    and s: "s  U"
    and s': "(s, v s)  ball (x, y) r"
    and U: "U  cball x e"
    for U v s
  proof -
    have H_eq: "H (s, v s) = H (s, u s)"
      apply (auto simp: H_def solves[OF s])
      unfolding u_def
      apply (rule G2)
      apply (rule subsetD; fact)
      done
    have "(s, snd (G (s, 0))) = (G (s, 0))"
      using GH H_def s s' solves by fastforce
    also have "  ball (x, y) r"
      unfolding G_def
      apply (rule the_inv_into_into)
        apply fact
       apply (rule u0)
       apply (rule subsetD; fact)
      apply (rule order_refl)
      done
    finally have "(s, u s)  ball (x, y) r" unfolding u_def .
    from inj_onD[OF inj H_eq s' this]
    show "u s = v s"
      by auto
  qed
  ultimately show ?thesis
    unfolding u_def Hi' ..
qed

lemma implicit_function_theorem_unique:
  fixes f::"'a::euclidean_space * 'b::euclidean_space  'c::euclidean_space"― ‹TODO: generalize?!›
  assumes f'[derivative_intros]: "x. x  S  (f has_derivative blinfun_apply (f' x)) (at x)"
  assumes S: "(x, y)  S" "open S"
  assumes D: "DIM('c)  DIM('b)"
  assumes f'C: "continuous_on S f'"
  assumes z: "f (x, y) = 0"
  assumes T2: "T oL (f' (x, y) oL embed2_blinfun) = 1L"
  assumes T1: "(f' (x, y) oL embed2_blinfun) oL T = 1L"― ‹TODO: reduce?!›
  obtains u e
  where "f (x, u x) = 0" "u x = y"
    "s. s  cball x e  f (s, u s) = 0"
    "continuous_on (cball x e) u"
    "(λt. (t, u t)) ` cball x e  S"
    "e > 0"
    "(u has_derivative (- T oL f' (x, y) oL embed1_blinfun)) (at x)"
    "s. s  cball x e  f' (s, u s) oL embed2_blinfun  invertibles_blinfun"
    "U v s. (s. s  U  f (s, v s) = 0) 
      u x = v x 
      continuous_on U v  s  U  x  U  U  cball x e  connected U  open U  u s = v s"
proof -
  from T1 T2 have f'I: "f' (x, y) oL embed2_blinfun  invertibles_blinfun"
    by (auto simp: invertibles_blinfun_def)
  from assms have f'Cg: "s  S  isCont f' s" for s
    by (auto simp: continuous_on_eq_continuous_at[OF ‹open S])
  then have f'C: "isCont f' (x, y)" by (auto simp: S)
  obtain u e1 r
    where u: "f (x, u x) = 0" "u x = y"
      "s. s  cball x e1  f (s, u s) = 0"
      "continuous_on (cball x e1) u"
      "(λt. (t, u t)) ` cball x e1  S"
      "e1 > 0"
    "(u has_derivative (- T oL f' (x, y) oL embed1_blinfun)) (at x)"
    and unique_u: "r > 0"
      "(v s U. v x = y 
        (s. s  U  f (s, v s) = 0) 
        continuous_on U v  s  U  U  cball x e1  (s, v s)  ball (x, y) r  u s = v s)"
    by (rule implicit_function_theorem[OF f' S D f'C z T2 T1]; blast)

  from openE[OF blinfun_inverse_open f'I] obtain d where d:
    "0 < d" "ball (f' (x, y) oL embed2_blinfun) d  invertibles_blinfun"
    by auto
  note [continuous_intros] = continuous_at_compose[OF _ f'Cg, unfolded o_def]
  from ‹continuous_on _ u
  have "continuous_on (ball x e1) u" by (rule continuous_on_subset) auto
  then have "s. s  ball x e1  isCont u s"
    unfolding continuous_on_eq_continuous_at[OF open_ball] by auto
  note [continuous_intros] = continuous_at_compose[OF _ this, unfolded o_def]
  from assms have f'Ce: "isCont (λs. f' (s, u s) oL embed2_blinfun) x"
    by (auto simp: u intro!: continuous_intros)
  from f'Ce[unfolded isCont_def, THEN tendstoD, OF 0 < d] d
  obtain e0 where "e0 > 0" "s. s  x  s  ball x e0 
      (f' (s, u s) oL embed2_blinfun)  invertibles_blinfun"
    by (auto simp: eventually_at dist_commute subset_iff u)
  then have e0: "s  ball x e0  (f' (s, u s) oL embed2_blinfun)  invertibles_blinfun" for s
    by (cases "s = x") (auto simp: f'I 0 < d u)


  define e where "e = min (e0/2) (e1/2)"
  have e: "f (x, u x) = 0"
      "u x = y"
      "s. s  cball x e  f (s, u s) = 0"
      "continuous_on (cball x e) u"
      "(λt. (t, u t)) ` cball x e  S"
      "e > 0"
      "(u has_derivative (- T oL f' (x, y) oL embed1_blinfun)) (at x)"
      "s. s  cball x e  f' (s, u s) oL embed2_blinfun  invertibles_blinfun"
    using e0 u e0 > 0 by (auto simp: e_def intro: continuous_on_subset)

  from u(4) have "continuous_on (ball x e1) u"
    apply (rule continuous_on_subset)
    using e1 > 0
    by (auto simp: e_def)
  then have "s. s  cball x e  isCont u s"
    using e0 > 0 e1 > 0
    unfolding continuous_on_eq_continuous_at[OF open_ball] by (auto simp: e_def Ball_def dist_commute)
  note [continuous_intros] = continuous_at_compose[OF _ this, unfolded o_def]

  have "u s = v s"
    if solves: "(s. s  U  f (s, v s) = 0)"
    and i: "u x = v x"
    and v: "continuous_on U v"
    and s: "s  U" and U: "x  U" "U  cball x e" "connected U" "open U"
    for U v s
  proof -
    define M where "M = {s  U. u s = v s}"
    have "x  M" using i U by (auto simp: M_def)
    moreover
    have "continuous_on U (λs. u s - v s)"
      by (auto intro!: continuous_intros v continuous_on_subset[OF e(4) U(2)])
    from continuous_closedin_preimage[OF this closed_singleton[where a=0]]
    have "closedin (top_of_set U) M"
      by (auto simp: M_def vimage_def Collect_conj_eq)
    moreover
    have "s. s  U   isCont v s"
      using v
      unfolding continuous_on_eq_continuous_at[OF ‹open U] by auto
    note [continuous_intros] = continuous_at_compose[OF _ this, unfolded o_def]
    {
      fix a assume "a  M"
      then have aU: "a  U" and u_v: "u a = v a"
        by (auto simp: M_def)
      then have a_ball: "a  cball x e" and a_dist: "dist x a  e" using U by auto
      then have a_S: "(a, u a)  S"
        using e by auto
      have fa_z: "f (a, u a) = 0"
        using a  cball x e by (auto intro!: e)
      from e(8)[OF a  cball _ _]
      obtain Ta where Ta: "Ta oL (f' (a, u a) oL embed2_blinfun) = 1L" "f' (a, u a) oL embed2_blinfun oL Ta = 1L"
        by (auto simp: invertibles_blinfun_def ac_simps)
      obtain u' e' r'
        where "r' > 0" "e' > 0"
        and u': "v s U. v a = u a 
             (s. s  U  f (s, v s) = 0) 
             continuous_on U v  s  U  U  cball a e'  (s, v s)  ball (a, u a) r'  u' s = v s"
        by (rule implicit_function_theorem[OF f' a_S ‹open S D f'Cg[OF a_S] fa_z Ta]; blast)
      from openE[OF ‹open U aU] obtain dU where dU: "dU > 0" "s. s  ball a dU  s  U"
        by (auto simp: dist_commute subset_iff)

      have v_tendsto: "((λs. (s, v s))  (a, u a)) (at a)"
        unfolding u_v
        by (subst continuous_at[symmetric]) (auto intro!: continuous_intros aU)
      from tendstoD[OF v_tendsto 0 < r', unfolded eventually_at]
      obtain dv where "dv > 0" "s  a  dist s a < dv  (s, v s)  ball (a, u a) r'" for s
        by (auto simp: dist_commute)
      then have dv: "dist s a < dv  (s, v s)  ball (a, u a) r'" for s
        by (cases "s = a") (auto simp: u_v 0 < r')

      have v_tendsto: "((λs. (s, u s))  (a, u a)) (at a)"
        using a_dist
        by (subst continuous_at[symmetric]) (auto intro!: continuous_intros)
      from tendstoD[OF v_tendsto 0 < r', unfolded eventually_at]
      obtain du where "du > 0" "s  a  dist s a < du  (s, u s)  ball (a, u a) r'" for s
        by (auto simp: dist_commute)
      then have du: "dist s a < du  (s, u s)  ball (a, u a) r'" for s
        by (cases "s = a") (auto simp: u_v 0 < r')
      {
        fix s assume s: "s  ball a (Min {dU, e', dv, du})"
        let ?U = "ball a (Min {dU, e', dv, du})"
        have balls: "ball a (Min {dU, e', dv, du})  cball a e'" by auto
        have dsadv: "dist s a < dv"
          using s by (auto simp: dist_commute)
        have dsadu: "dist s a < du"
          using s by (auto simp: dist_commute)
        have U_U: "s. s  ball a (Min {dU, e', dv, du})  s  U"
          using dU by auto
        have U_e: "s. s  ball a (Min {dU, e', dv, du})  s  cball x e"
          using dU U by (auto simp: dist_commute subset_iff)
        have cv: "continuous_on ?U v"
          using v
          apply (rule continuous_on_subset)
          using dU
          by auto
        have cu: "continuous_on ?U u"
          using e(4)
          apply (rule continuous_on_subset)
          using dU U(2)
          by auto
        from u'[where v=v, OF u_v[symmetric] solves[OF U_U] cv s balls dv[OF dsadv]]
          u'[where v=u, OF refl              e(3)[OF U_e]   cu s balls du[OF dsadu]]
        have "v s = u s" by auto
      } then have "dv>0. s  ball a dv. v s = u s"
        using 0 < dU 0 < e' 0 < dv 0 < du
        by (auto intro!: exI[where x="(Min {dU, e', dv, du})"])
    } note ex = this
    have "openin (top_of_set U) M"
      unfolding openin_contains_ball
      apply (rule conjI)
      subgoal using U by (auto simp: M_def)
      apply (auto simp:)
      apply (drule ex)
      apply auto
      subgoal for x d
        by (rule exI[where x=d]) (auto simp: M_def)
      done
    ultimately have "M = U"
      using ‹connected U
      by (auto simp: connected_clopen)
    with s  U show ?thesis by (auto simp: M_def)
  qed
  from e this
  show ?thesis ..
qed

lemma uniform_limit_compose:
  assumes ul: "uniform_limit T f l F"
  assumes uc: "uniformly_continuous_on S s"
  assumes ev: "F x in F. f x ` T  S"
  assumes subs: "l ` T  S"
  shows  "uniform_limit T (λi x. s (f i x)) (λx. s (l x)) F"
proof (rule uniform_limitI)
  fix e::real assume "e > 0"
  from uniformly_continuous_onE[OF uc e > 0]
  obtain d where d: "0 < d" "t t'. t  S  t'  S  dist t' t < d  dist (s t') (s t) < e"
    by auto
  from uniform_limitD[OF ul 0 < d] have "F n in F. xT. dist (f n x) (l x) < d" .
  then show "F n in F. xT. dist (s (f n x)) (s (l x)) < e"
    using ev
    by eventually_elim (use d subs in force)
qed

lemma
  uniform_limit_in_open:
  fixes l::"'a::topological_space'b::heine_borel"
  assumes ul: "uniform_limit T f l (at x)"
  assumes cont: "continuous_on T l"
  assumes compact: "compact T" and T_ne: "T  {}"
  assumes B: "open B"
  assumes mem: "l ` T  B"
  shows "F y in at x. t  T. f y t  B"
proof -
  have l_ne: "l ` T  {}" using T_ne by auto
  have "compact (l ` T)"
    by (auto intro!: compact_continuous_image cont compact)
  from compact_in_open_separated[OF l_ne this B mem]
  obtain e where "e > 0" "{x. infdist x (l ` T)  e}  B"
    by auto
  from uniform_limitD[OF ul 0 < e]
  have "F n in at x. xT. dist (f n x) (l x) < e" .
  then show ?thesis
  proof eventually_elim
    case (elim y)
    show ?case
    proof safe
      fix t assume "t  T"
      have "infdist (f y t) (l ` T)  dist (f y t) (l t)"
        by (rule infdist_le) (use t  T in auto)
      also have " < e" using elim t  T by auto
      finally have "infdist (f y t) (l ` T)  e" by simp
      then have "(f y t)  {x. infdist x (l ` T)  e}"
        by (auto )
      also note   B
      finally show "f y t  B" .
    qed
  qed
qed

lemma
  order_uniform_limitD1:
  fixes l::"'a::topological_spacereal"― ‹TODO: generalize?!›
  assumes ul: "uniform_limit T f l (at x)"
  assumes cont: "continuous_on T l"
  assumes compact: "compact T"
  assumes less: "t. t  T  l t < b"
  shows "F y in at x. t  T. f y t < b"
proof cases
  assume ne: "T  {}"
  from compact_attains_sup[OF compact_continuous_image[OF cont compact], unfolded image_is_empty, OF ne]
  obtain tmax where tmax: "tmax  T" "s. s  T  l s  l tmax"
    by auto
  have "b - l tmax > 0"
    using ne tmax less by auto
  from uniform_limitD[OF ul this]
  have "F n in at x. xT. dist (f n x) (l x) < b - l tmax"
    by auto
  then show ?thesis
    apply eventually_elim
    using tmax
    by (force simp: dist_real_def abs_real_def split: if_splits)
qed auto

lemma
  order_uniform_limitD2:
  fixes l::"'a::topological_spacereal"― ‹TODO: generalize?!›
  assumes ul: "uniform_limit T f l (at x)"
  assumes cont: "continuous_on T l"
  assumes compact: "compact T"
  assumes less: "t. t  T  l t > b"
  shows "F y in at x. t  T. f y t > b"
proof -
  have "F y in at x. tT. (- f) y t < - b"
    by (rule order_uniform_limitD1[of "- f" T "-l" x "- b"])
      (auto simp: assms fun_Compl_def intro!: uniform_limit_eq_intros continuous_intros)
  then show ?thesis by auto
qed

lemma continuous_on_avoid_cases:
  fixes l::"'b::topological_space  'a::linear_continuum_topology"― ‹TODO: generalize!›
  assumes cont: "continuous_on T l" and conn: "connected T"
  assumes avoid: "t. t  T  l t  b"
  obtains "t. t  T  l t < b" | "t. t  T  l t > b"
  apply atomize_elim
  using connected_continuous_image[OF cont conn] using avoid
  unfolding connected_iff_interval
  apply (auto simp: image_iff)
  using leI by blast

lemma
  order_uniform_limit_ne:
  fixes l::"'a::topological_spacereal"― ‹TODO: generalize?!›
  assumes ul: "uniform_limit T f l (at x)"
  assumes cont: "continuous_on T l"
  assumes compact: "compact T" and conn: "connected T"
  assumes ne: "t. t  T  l t  b"
  shows "F y in at x. t  T. f y t  b"
proof -
  from continuous_on_avoid_cases[OF cont conn ne]
  consider "(t. t  T  l t < b)" | "(t. t  T  l t > b)"
    by blast
  then show ?thesis
  proof cases
    case 1
    from order_uniform_limitD1[OF ul cont compact 1]
    have "F y in at x. tT. f y t < b" by simp
    then show ?thesis
      by eventually_elim auto
  next
    case 2
    from order_uniform_limitD2[OF ul cont compact 2]
    have "F y in at x. tT. f y t > b" by simp
    then show ?thesis
      by eventually_elim auto
  qed
qed

lemma open_cballE:
  assumes "open S" "xS"
  obtains e where "e>0" "cball x e  S"
  using assms unfolding open_contains_cball by auto

lemma pos_half_less: fixes x::real shows "x > 0  x / 2 < x"
  by auto

lemma closed_levelset: "closed {x. s x = (c::'a::t1_space)}" if "continuous_on UNIV s"
proof -
  have "{x. s x = c} = s -` {c}" by auto
  also have "closed "
    apply (rule closed_vimage)
     apply (rule closed_singleton)
    apply (rule that)
    done
  finally show ?thesis .
qed

lemma closed_levelset_within: "closed {x  S. s x = (c::'a::t1_space)}" if "continuous_on S s" "closed S"
proof -
  have "{x  S. s x = c} = s -` {c}  S" by auto
  also have "closed "
    apply (rule continuous_on_closed_vimageI)
      apply (rule that)
     apply (rule that)
    apply simp
    done
  finally show ?thesis .
qed

context c1_on_open_euclidean
begin

lemma open_existence_ivlE:
  assumes "t  existence_ivl0 x" "t  0"
  obtains e where "e > 0" "cball x e × {0 .. t + e}  Sigma X existence_ivl0"
proof -
  from assms have "(x, t)  Sigma X existence_ivl0"
    by auto
  from open_cballE[OF open_state_space this]
  obtain e0' where e0: "0 < e0'" "cball (x, t) e0'  Sigma X existence_ivl0"
    by auto
  define e0 where "e0 = (e0' / 2)"
  from cball_times_subset[of x e0' t] pos_half_less[OF 0 < e0'] half_gt_zero[OF 0 < e0'] e0
  have "cball x e0 × cball t e0  Sigma X existence_ivl0" "0 < e0" "e0 < e0'"
    unfolding e0_def by auto
  then have "e0 > 0" "cball x e0 × {0..t + e0}  Sigma X existence_ivl0"
    apply (auto simp: subset_iff dest!: spec[where x=t])
    subgoal for a b
      apply (rule in_existence_between_zeroI)
      apply (drule spec[where x=a])
       apply (drule spec[where x="t + e0"])
       apply (auto simp: dist_real_def closed_segment_eq_real_ivl)
      done
    done
  then show ?thesis ..
qed

lemmas [derivative_intros] = flow0_comp_has_derivative

lemma flow_isCont_state_space_comp[continuous_intros]:
  "t x  existence_ivl0 (s x)  isCont s x  isCont t x  isCont (λx. flow0 (s x) (t x)) x"
  using continuous_within_compose3[where g="λ(x, t). flow0 x t"
      and f="λx. (s x, t x)" and x = x and s = UNIV]
  flow_isCont_state_space
  by auto

lemma closed_plane[simp]: "closed {x. x  i = c}"
  using closed_hyperplane[of i c] by (auto simp: inner_commute)

lemma flow_tendsto_compose[tendsto_intros]:
  assumes "(x  xs) F" "(t  ts) F"
  assumes "ts  existence_ivl0 xs"
  shows "((λs. flow0 (x s) (t s))  flow0 xs ts) F"
proof -
  have ev: "F s in F. (x s, t s)  Sigma X existence_ivl0"
    using tendsto_Pair[OF assms(1,2), THEN topological_tendstoD, OF open_state_space]
      assms
    by auto
  show ?thesis
    by (rule continuous_on_tendsto_compose[OF flow_continuous_on_state_space tendsto_Pair, unfolded split_beta' fst_conv snd_conv])
      (use assms ev in auto)
qed

lemma returns_to_implicit_function:
  fixes s::"'a::euclidean_space  real"
  assumes rt: "returns_to {x  S. s x = 0} x" (is "returns_to ?P x")
  assumes cS: "closed S"
  assumes Ds: "x. (s has_derivative blinfun_apply (Ds x)) (at x)"
  assumes DsC: "isCont Ds (poincare_map ?P x)"
  assumes nz: "Ds (poincare_map ?P x) (f (poincare_map ?P x))  0"
  obtains u e
  where "s (flow0 x (u x)) = 0"
      "u x = return_time ?P x"
      "(y. y  cball x e  s (flow0 y (u y)) = 0)"
      "continuous_on (cball x e) u"
      "(λt. (t, u t)) ` cball x e  Sigma X existence_ivl0"
      "0 < e" "(u has_derivative (- blinfun_scaleR_left
                   (inverse (blinfun_apply (Ds (poincare_map ?P x)) (f (poincare_map ?P x)))) oL
                      (Ds (poincare_map ?P x) oL flowderiv x (return_time ?P x)) oL embed1_blinfun)) (at x)"
proof -
  note [derivative_intros] = has_derivative_compose[OF _ Ds]
  have cont_s: "continuous_on UNIV s" by (rule has_derivative_continuous_on[OF Ds])
  note cls[simp, intro] = closed_levelset[OF cont_s]
  let ?t1 = "return_time ?P x"
  have cls[simp, intro]: "closed {x  S. s x = 0}"
    by (rule closed_levelset_within) (auto intro!: cS continuous_on_subset[OF cont_s])
  then have xt1: "(x, ?t1)  Sigma X existence_ivl0"
    by (auto intro!: return_time_exivl rt)
  have D: "(x. x  Sigma X existence_ivl0 
      ((λ(x, t). s (flow0 x t)) has_derivative
       blinfun_apply (Ds (flow0 (fst x) (snd x)) oL (flowderiv (fst x) (snd x))))
       (at x))"
    by (auto intro!: derivative_eq_intros)
  have C: "isCont (λx. Ds (flow0 (fst x) (snd x)) oL flowderiv (fst x) (snd x))
   (x, ?t1)"
    using flowderiv_continuous_on[unfolded continuous_on_eq_continuous_within,
        rule_format, OF xt1]
    using at_within_open[OF xt1 open_state_space]
    by (auto intro!: continuous_intros tendsto_eq_intros return_time_exivl rt
          isCont_tendsto_compose[OF DsC, unfolded poincare_map_def]
        simp: split_beta' isCont_def)
  from return_time_returns[OF rt cls]
  have Z: "(case (x, ?t1) of (x, t)  s (flow0 x t)) = 0"
    by (auto simp: )
  have I1: "blinfun_scaleR_left (inverse (Ds (flow0 x (?t1))(f (flow0 x (?t1))))) oL 
    ((Ds (flow0 (fst (x, return_time {x  S. s x = 0} x))
            (snd (x, return_time {x  S. s x = 0} x))) oL
       flowderiv (fst (x, return_time {x  S. s x = 0} x))
        (snd (x, return_time {x  S. s x = 0} x))) oL
      embed2_blinfun)
     = 1L"
    using nz
    by (auto intro!: blinfun_eqI
        simp: rt flowderiv_def blinfun.bilinear_simps inverse_eq_divide poincare_map_def)
  have I2: "((Ds (flow0 (fst (x, return_time {x  S. s x = 0} x))
            (snd (x, return_time {x  S. s x = 0} x))) oL
       flowderiv (fst (x, return_time {x  S. s x = 0} x))
        (snd (x, return_time {x  S. s x = 0} x))) oL
      embed2_blinfun) oL blinfun_scaleR_left (inverse (Ds (flow0 x (?t1))(f (flow0 x (?t1)))))
     = 1L"
    using nz
    by (auto intro!: blinfun_eqI
        simp: rt flowderiv_def blinfun.bilinear_simps inverse_eq_divide poincare_map_def)
  show ?thesis
    apply (rule implicit_function_theorem[where f="λ(x, t). s (flow0 x t)"
          and S="Sigma X existence_ivl0", OF D xt1 open_state_space order_refl C Z I1 I2])
     apply blast
    unfolding split_beta' fst_conv snd_conv poincare_map_def[symmetric]
    ..
qed

lemma (in auto_ll_on_open) f_tendsto[tendsto_intros]:
  assumes g1: "(g1  b1) (at s within S)" and "b1  X"
  shows "((λx. f (g1 x))  f b1) (at s within S)"
  apply (rule continuous_on_tendsto_compose[OF continuous tendsto_Pair[OF tendsto_const],
      unfolded split_beta fst_conv snd_conv, OF g1])
  by (auto simp: b1  X intro!: topological_tendstoD[OF g1])

lemma flow_avoids_surface_eventually_at_right_pos:
  assumes "s x > 0  s x = 0  blinfun_apply (Ds x) (f x) > 0"
  assumes x: "x  X"
  assumes Ds: "x. (s has_derivative Ds x) (at x)"
  assumes DsC: "x. isCont Ds x"
  shows "F t in at_right 0. s (flow0 x t) > (0::real)"
proof -
  have cont_s: "continuous_on UNIV s" by (rule has_derivative_continuous_on[OF Ds])
  then have [THEN continuous_on_compose2, continuous_intros]: "continuous_on S s" for S by (rule continuous_on_subset) simp
  note [derivative_intros] = has_derivative_compose[OF _ Ds]
  note [tendsto_intros] = continuous_on_tendsto_compose[OF cont_s]
    isCont_tendsto_compose[OF DsC]
  from assms(1)
  consider "s x > 0" | "s x = 0" "blinfun_apply (Ds x) (f x) > 0"
    by auto
  then show ?thesis
  proof cases
    assume s: "s x > 0"
    then have "((λt. s (flow0 x t))  s x) (at_right 0)"
      by (auto intro!: tendsto_eq_intros simp: split_beta' x)
    from order_tendstoD(1)[OF this s]
    show ?thesis .
  next
    assume sz: "s x = 0" and pos: "blinfun_apply (Ds x) (f x) > 0"
    from x have "0  existence_ivl0 x" "open (existence_ivl0 x)" by simp_all
    then have evex: "F t in at_right 0. t  existence_ivl0 x"
      using eventually_at_topological by blast
    moreover
    from evex have "F xa in at_right 0. flow0 x xa  X"
      by (eventually_elim) (auto intro!: )
    then have "((λt. (Ds (flow0 x t)) (f (flow0 x t)))  blinfun_apply (Ds x) (f x)) (at_right 0)"
      by (auto intro!: tendsto_eq_intros simp: split_beta' x)
    from order_tendstoD(1)[OF this pos]
    have "F z in at_right 0. blinfun_apply (Ds (flow0 x z)) (f (flow0 x z)) > 0" .
    then obtain t where t: "t > 0" "z. 0 < z  z < t  blinfun_apply (Ds (flow0 x z)) (f (flow0 x z)) > 0"
      by (auto simp: eventually_at)
    have "F z in at_right 0. z < t" using t > 0 order_tendstoD(2)[OF tendsto_ident_at 0 < t] by auto
    moreover have "F z in at_right 0. 0 < z" by (simp add: eventually_at_filter)
    ultimately show ?thesis
    proof eventually_elim
      case (elim z)
      from closed_segment_subset_existence_ivl[OF z  existence_ivl0 x]
      have csi: "{0..z}  existence_ivl0 x" by (auto simp add: closed_segment_eq_real_ivl)
      then have cont: "continuous_on {0..z} (λt. s (flow0 x t))"
        by (auto intro!: continuous_intros)
      have "u. 0 < u; u < z  ((λt. s (flow0 x t)) has_derivative (λt. t * blinfun_apply (Ds (flow0 x u)) (f (flow0 x u)))) (at u)"
        using csi
        by (auto intro!: derivative_eq_intros simp: flowderiv_def blinfun.bilinear_simps)
      from mvt[OF 0 < z cont this]
      obtain w where w: "0 < w" "w < z" and sDs: "s (flow0 x z) = z * blinfun_apply (Ds (flow0 x w)) (f (flow0 x w))"
        using x sz
        by auto
      note sDs
      also have " > 0"
        using elim t(2)[of w] w by simp
      finally show ?case .
    qed
  qed
qed

lemma flow_avoids_surface_eventually_at_right_neg:
  assumes "s x < 0  s x = 0  blinfun_apply (Ds x) (f x) < 0"
  assumes x: "x  X"
  assumes Ds: "x. (s has_derivative Ds x) (at x)"
  assumes DsC: "x. isCont Ds x"
  shows "F t in at_right 0. s (flow0 x t) < (0::real)"
  apply (rule flow_avoids_surface_eventually_at_right_pos[of "-s" x "-Ds", simplified])
  using assms
  by (auto intro!: derivative_eq_intros simp: blinfun.bilinear_simps fun_Compl_def)

lemma flow_avoids_surface_eventually_at_right:
  assumes "x  S  s x  0  blinfun_apply (Ds x) (f x)  0"
  assumes x: "x  X" and cS: "closed S"
  assumes Ds: "x. (s has_derivative Ds x) (at x)"
  assumes DsC: "x. isCont Ds x"
  shows "F t in at_right 0. (flow0 x t)  {x  S. s x = (0::real)}"
proof -
  from assms(1)
  consider
      "s x > 0  s x = 0  blinfun_apply (Ds x) (f x) > 0"
    | "s x < 0  s x = 0  blinfun_apply (Ds x) (f x) < 0"
    | "x  S"
    by arith
  then show ?thesis
  proof cases
    case 1
    from flow_avoids_surface_eventually_at_right_pos[of s x Ds, OF 1 x Ds DsC]
    show ?thesis by eventually_elim auto
  next
    case 2
    from flow_avoids_surface_eventually_at_right_neg[of s x Ds, OF 2 x Ds DsC]
    show ?thesis by eventually_elim auto
  next
    case 3
    then have nS: "open (- S)" "x  - S" using cS by auto
    have "F t in at_right 0. (flow0 x t)  - S"
      by (rule topological_tendstoD[OF _ nS]) (auto intro!: tendsto_eq_intros simp: x)
    then show ?thesis by eventually_elim auto
  qed
qed

lemma eventually_returns_to:
  fixes s::"'a::euclidean_space  real"
  assumes rt: "returns_to {x  S. s x = 0} x" (is "returns_to ?P x")
  assumes cS: "closed S"
  assumes Ds: "x. (s has_derivative blinfun_apply (Ds x)) (at x)"
  assumes DsC: "x. isCont Ds x"
  assumes eventually_inside: "F x in at (poincare_map ?P x). s x = 0  x  S"
  assumes nz: "Ds (poincare_map ?P x) (f (poincare_map ?P x))  0"
  assumes nz0: "x  S  s x  0  Ds x (f x)  0"
  shows "F x in at x. returns_to ?P x"
proof -
  let ?t1 = "return_time ?P x"
  have cont_s: "continuous_on UNIV s" by (rule has_derivative_continuous_on[OF Ds])
  have cont_s': "continuous_on S s" for S by (rule continuous_on_subset[OF cont_s subset_UNIV])
  note s_tendsto[tendsto_intros] = continuous_on_tendsto_compose[OF cont_s, THEN tendsto_eq_rhs]
  note cls[simp, intro] = closed_levelset_within[OF cont_s' cS, of 0]
  note [tendsto_intros] = continuous_on_tendsto_compose[OF cont_s]
    isCont_tendsto_compose[OF DsC]
  obtain u e
    where "s (flow0 x (u x)) = 0"
      "u x = return_time ?P x"
      "(y. y  cball x e  s (flow0 y (u y)) = 0)"
      "continuous_on (cball x e) u"
      "(λt. (t, u t)) ` cball x e  Sigma X existence_ivl0"
      "0 < e"
    by (rule returns_to_implicit_function[OF rt cS Ds DsC nz]; blast)
  then have u:
    "s (flow0 x (u x)) = 0" "u x = ?t1"
    "(y. y  cball x e  s (flow0 y (u y)) = 0)"
    "continuous_on (cball x e) u"
    "z. z  cball x e  u z  existence_ivl0 z"
    "e > 0"
    by (force simp: split_beta')+
  have "F y in at x. y  ball x e"
    using eventually_at_ball[OF 0 < e]
    by eventually_elim auto
  then have ev_cball: "F y in at x. y  cball x e"
    by eventually_elim (use e > 0 in auto)
  moreover
  have "continuous_on (ball x e) u"
    using u by (auto simp: continuous_on_subset)
  then have [tendsto_intros]: "(u  u x) (at x)"
    using e > 0 at_within_open[of y "ball x e" for y]
    by (auto simp: continuous_on_def)
  then have flow0_u_tendsto: "(λx. flow0 x (u x)) x poincare_map ?P x"
    by (auto intro!: tendsto_eq_intros u return_time_exivl rt simp: poincare_map_def)
  have s_imp: "s (poincare_map {x  S. s x = 0} x) = 0  poincare_map {x  S. s x = 0} x  S"
    using poincare_map_returns[OF rt]
    by auto
  from eventually_tendsto_compose_within[OF eventually_inside s_imp flow0_u_tendsto]
  have "F x in at x. s (flow0 x (u x)) = 0  flow0 x (u x)  S" by auto
  with ev_cball
  have "F x in at x. flow0 x (u x)  S"
    by eventually_elim (auto simp: u)
  moreover
  {
    have "x  X"
      using u(5) u(6) by force
    from ev_cball
    have ev_X: "F y in at x. y  X"― ‹eigentlich ist das open X›
      apply eventually_elim
      apply (rule)
      by (rule u)
    moreover
    {
      {
        assume a: "x  S" then have "open (-S)" "x  - S" using cS by auto
        from topological_tendstoD[OF tendsto_ident_at this]
        have "(F y in at x. y  S)" by auto
      } moreover {
        assume a: "s x  0"
        have "(F y in at x. s y  0)"
          by (rule tendsto_imp_eventually_ne[OF _ a]) (auto intro!: tendsto_eq_intros)
      } moreover {
        assume a: "(Ds x) (f x)  0"
        have "(F y in at x. blinfun_apply (Ds y) (f y)  0)"
          by (rule tendsto_imp_eventually_ne[OF _ a]) (auto intro!: tendsto_eq_intros ev_X x  X)
      } ultimately have "(F y in at x. y  S)  (F y in at x. s y  0)  (F y in at x. blinfun_apply (Ds y) (f y)  0)"
        using nz0 by auto
      then have "F y in at x. y  S  s y  0  blinfun_apply (Ds y) (f y)  0"
        apply -
        apply (erule disjE)
        subgoal by (rule eventually_elim2, assumption, assumption, blast)
        subgoal
          apply (erule disjE)
          subgoal by (rule eventually_elim2, assumption, assumption, blast)
          subgoal by (rule eventually_elim2, assumption, assumption, blast)
          done
        done
    }
    ultimately
    have "F y in at x. (y  S  s y  0  blinfun_apply (Ds y) (f y)  0)  y  X"
      by eventually_elim auto
  }
  then have "F y in at x. F t in at_right 0. flow0 y t  {x  S. s x = 0}"
    apply eventually_elim
    by (rule flow_avoids_surface_eventually_at_right[where Ds=Ds]) (auto intro!: Ds DsC cS)
  moreover
  have at_eq: "(at x within cball x e) = at x"
    apply (rule at_within_interior)
    apply (auto simp: e > 0)
    done
  have "u x > 0"
    using u(1) by (auto simp: u rt cont_s' intro!: return_time_pos closed_levelset_within cS)
  then have "F y in at x. u y > 0"
    apply (rule order_tendstoD[rotated])
    using u(4)
    apply (auto simp: continuous_on_def)
    apply (drule bspec[where x=x])
    using e > 0
    by (auto simp: at_eq)
  ultimately
  show "F y in at x. returns_to ?P y"
    apply eventually_elim
    subgoal premises prems for y
      apply (rule returns_toI[where t="u y"])
      subgoal using prems  by auto
      subgoal apply (rule u) apply (rule prems) done
      subgoal using u(3)[of y] prems by auto
      subgoal using prems(3) by eventually_elim auto
      subgoal by simp
      done
    done
qed

lemma
  return_time_isCont_outside:
  fixes s::"'a::euclidean_space  real"
  assumes rt: "returns_to {x  S. s x = 0} x" (is "returns_to ?P x")
  assumes cS: "closed S"
  assumes Ds: "x. (s has_derivative blinfun_apply (Ds x)) (at x)"
  assumes DsC: "x. isCont Ds x"
  assumes through: "(Ds (poincare_map ?P x)) (f (poincare_map ?P x))  0"
  assumes eventually_inside: "F x in at (poincare_map ?P x). s x = 0  x  S"
  assumes outside: "x  S  s x  0"
  shows "isCont (return_time ?P) x"
  unfolding isCont_def
proof (rule tendstoI)
  fix e_orig::real assume "e_orig > 0"
  define e where "e = e_orig / 2"
  have "e > 0" using e_orig > 0 by (simp add: e_def)

  have cont_s: "continuous_on UNIV s" by (rule has_derivative_continuous_on[OF Ds])
  then have s_tendsto: "(s  s x) (at x)" for x
    by (auto simp: continuous_on_def)
  have cont_s': "continuous_on S s" by (rule continuous_on_subset[OF cont_s subset_UNIV])
  note cls[simp, intro] = closed_levelset_within[OF cont_s' cS(1)]
  have "{x. s x = 0} = s -` {0}" by auto
  have ret_exivl: "return_time ?P x  existence_ivl0 x"
    by (rule return_time_exivl; fact)
  then have [intro, simp]: "x  X" by auto
  have isCont_Ds_f: "isCont (λs. Ds s (f s)) (poincare_map ?P x)"
    apply (auto intro!: continuous_intros DsC)
    apply (rule has_derivative_continuous)
    apply (rule derivative_rhs)
    by (auto simp: poincare_map_def intro!: flow_in_domain return_time_exivl assms)

  obtain u eu where u:
      "s (flow0 x (u x)) = 0"
      "u x = return_time ?P x"
      "(y. y  cball x eu  s (flow0 y (u y)) = 0)"
      "continuous_on (cball x eu) u"
      "(λt. (t, u t)) ` cball x eu  Sigma X existence_ivl0"
      "0 < eu"
    by (rule returns_to_implicit_function[OF rt cS(1) Ds DsC through]; blast)
  have u_tendsto: "(u  u x) (at x)"
    unfolding isCont_def[symmetric]
    apply (rule continuous_on_interior[OF u(4)])
    using 0 < eu by auto
  have "u x > 0" by (auto simp: u intro!: return_time_pos rt)
  from order_tendstoD(1)[OF u_tendsto this] have "F x in at x. 0 < u x" .
  moreover have "F y in at x. y  cball x eu"
    using eventually_at_ball[OF 0 < eu, of x]
    by eventually_elim auto
  moreover
  have "x  S  s x  0  blinfun_apply (Ds x) (f x)  0" using outside by auto
  have returns: "F y in at x. returns_to ?P y"
    by (rule eventually_returns_to; fact)
  moreover
  have "F y in at x. y  ball x eu"
    using eventually_at_ball[OF 0 < eu]
    by eventually_elim simp
  then have ev_cball: "F y in at x. y  cball x eu"
    by eventually_elim (use e > 0 in auto)
  have "continuous_on (ball x eu) u"
    using u by (auto simp: continuous_on_subset)
  then have [tendsto_intros]: "(u  u x) (at x)"
    using eu > 0 at_within_open[of y "ball x eu" for y]
    by (auto simp: continuous_on_def)
  then have flow0_u_tendsto: "(λx. flow0 x (u x)) x poincare_map ?P x"
    by (auto intro!: tendsto_eq_intros u return_time_exivl rt simp: poincare_map_def)
  have s_imp: "s (poincare_map {x  S. s x = 0} x) = 0  poincare_map {x  S. s x = 0} x  S"
    using poincare_map_returns[OF rt]
    by auto
  from eventually_tendsto_compose_within[OF eventually_inside s_imp flow0_u_tendsto]
  have "F x in at x. s (flow0 x (u x)) = 0  flow0 x (u x)  S" by auto
  with ev_cball
  have "F x in at x. flow0 x (u x)  S"
    by eventually_elim (auto simp: u)
  ultimately have u_returns_ge: "F y in at x. returns_to ?P y  return_time ?P y  u y"
  proof eventually_elim
    case (elim y)
    then show ?case
      using u elim by (auto intro!: return_time_le[OF _ cls])
  qed
  moreover
  have "F y in at x. u y - return_time ?P x < e"
    using tendstoD[OF u_tendsto 0 < e, unfolded u] u_returns_ge
    by eventually_elim (auto simp: dist_real_def)
  moreover
  note 1 = outside
  define ml where "ml = max (return_time ?P x / 2) (return_time ?P x - e)"
  have [intro, simp, arith]: "0 < ml" "ml < return_time ?P x" "ml  return_time ?P x"
    using return_time_pos[OF rt cls] 0 < e
    by (auto simp: ml_def)
  have mt_in: "ml  existence_ivl0 x"
    using 0 < e
    by (auto intro!: mem_existence_ivl_iv_defined in_existence_between_zeroI[OF ret_exivl]
        simp: closed_segment_eq_real_ivl ml_def)
  from open_existence_ivlE[OF mt_in]
  obtain e0 where e0: "e0 > 0" "cball x e0 × {0..ml + e0}  Sigma X existence_ivl0" (is "?D  _")
    by auto
  have uc: "uniformly_continuous_on ((λ(x, t). flow0 x t) ` ?D) s"
    apply (auto intro!: compact_uniformly_continuous continuous_on_subset[OF cont_s])
    apply (rule compact_continuous_image)
     apply (rule continuous_on_subset)
      apply (rule flow_continuous_on_state_space)
     apply (rule e0)
    apply (rule compact_Times)
     apply (rule compact_cball)
    apply (rule compact_Icc)
    done
  let ?T = "{0..ml}"
  have ul: "uniform_limit ?T flow0 (flow0 x) (at x)"
    using 0 < e
    by (intro uniform_limit_flow)
      (auto intro!: mem_existence_ivl_iv_defined in_existence_between_zeroI[OF ret_exivl]
        simp: closed_segment_eq_real_ivl )
  have "F y in at x. t{0..ml}. flow0 y t  - {x  S. s x = 0}"
    apply (rule uniform_limit_in_open)
    apply (rule ul)
       apply (auto intro!: continuous_intros continuous_on_compose2[OF cont_s] simp:
        split: if_splits)
     apply (meson atLeastAtMost_iff contra_subsetD local.ivl_subset_existence_ivl mt_in)
    subgoal for t
      apply (cases "t = 0")
      subgoal using 1 by (simp)
      subgoal
        using return_time_least[OF rt cls, of t] ml < return_time {x  S. s x = 0} x
        by auto
      done
    done
  then have "F y in at x. return_time ?P y  return_time ?P x - e"
    using u_returns_ge
  proof eventually_elim
    case (elim y)
    have "return_time ?P x - e  ml"
      by (auto simp: ml_def)
    also
    have ry: "returns_to ?P y" "return_time ?P y  u y"
      using elim
      by auto
    have "ml < return_time ?P y"
      apply (rule return_time_gt[OF ry(1) cls])
      using elim
      by (auto simp: Ball_def)
    finally show ?case by simp
  qed
  ultimately
  have "F y in at x. dist (return_time ?P y) (return_time ?P x)  e"
    by eventually_elim (auto simp: dist_real_def abs_real_def algebra_simps)
  then show "F y in at x. dist (return_time ?P y) (return_time ?P x) < e_orig"
    by eventually_elim (use e_orig > 0 in auto simp: e_def›)
qed

lemma isCont_poincare_map:
  assumes "isCont (return_time P) x"
    "returns_to P x" "closed P"
  shows "isCont (poincare_map P) x"
  unfolding poincare_map_def
  by (auto intro!: continuous_intros assms return_time_exivl)

lemma poincare_map_tendsto:
  assumes "(return_time P  return_time P x) (at x within S)"
    "returns_to P x" "closed P"
  shows "(poincare_map P  poincare_map P x) (at x within S)"
  unfolding poincare_map_def
  by (rule tendsto_eq_intros refl assms return_time_exivl)+

lemma
  return_time_continuous_below:
  fixes s::"'a::euclidean_space  real"
  assumes rt: "returns_to {x  S. s x = 0} x" (is "returns_to ?P x")
  assumes Ds: "x. (s has_derivative blinfun_apply (Ds x)) (at x)"
  assumes cS: "closed S"
  assumes eventually_inside: "F x in at (poincare_map ?P x). s x = 0  x  S"
  assumes DsC: "x. isCont Ds x"
  assumes through: "(Ds (poincare_map ?P x)) (f (poincare_map ?P x))  0"
  assumes inside: "x  S" "s x = 0" "Ds x (f x) < 0"
  shows "continuous (at x within {x. s x  0}) (return_time ?P)"
  unfolding continuous_within
proof (rule tendstoI)
  fix e_orig::real assume "e_orig > 0"
  define e where "e = e_orig / 2"
  have "e > 0" using e_orig > 0 by (simp add: e_def)

  note DsC_tendso[tendsto_intros] = isCont_tendsto_compose[OF DsC]
  have cont_s: "continuous_on UNIV s" by (rule has_derivative_continuous_on[OF Ds])
  then have s_tendsto: "(s  s x) (at x)" for x
    by (auto simp: continuous_on_def)
  note [continuous_intros] = continuous_on_compose2[OF cont_s _ subset_UNIV]
  note [derivative_intros] = has_derivative_compose[OF _ Ds]
  have cont_s': "continuous_on S s" by (rule continuous_on_subset[OF cont_s subset_UNIV])
  note cls[simp, intro] = closed_levelset_within[OF cont_s' cS(1)]
  have "{x. s x = 0} = s -` {0}" by auto
  have ret_exivl: "return_time ?P x  existence_ivl0 x"
    by (rule return_time_exivl; fact)
  then have [intro, simp]: "x  X" by auto
  have isCont_Ds_f: "isCont (λs. Ds s (f s)) (poincare_map ?P x)"
    apply (auto intro!: continuous_intros DsC)
    apply (rule has_derivative_continuous)
    apply (rule derivative_rhs)
    by (auto simp: poincare_map_def intro!: flow_in_domain return_time_exivl assms)

  have "F yt in at (x, 0) within UNIV × {0<..}. (Ds (flow0 (fst yt) (snd yt))) (f (flow0 (fst yt) (snd yt))) < 0"
    by (rule order_tendstoD) (auto intro!: tendsto_eq_intros inside)
  moreover
  have "(x, 0)  Sigma X existence_ivl0" by auto
  from topological_tendstoD[OF tendsto_ident_at open_state_space this, of "UNIV × {0<..}"]
  have "F yt in at (x, 0) within UNIV × {0<..}. snd yt  existence_ivl0 (fst yt)"
    by eventually_elim auto
  moreover
  from topological_tendstoD[OF tendsto_ident_at open_Times[OF open_dom open_UNIV], of "(x, 0)" "UNIV × {0<..}"]
  have "F yt in at (x, 0) within UNIV × {0<..}. fst yt  X"
    by (auto simp: mem_Times_iff)
  ultimately
  have "F yt in at (x, 0) within UNIV × {0<..}. (Ds (flow0 (fst yt) (snd yt))) (f (flow0 (fst yt) (snd yt))) < 0 
    snd yt  existence_ivl0 (fst yt) 
    0  existence_ivl0 (fst yt)"
    by eventually_elim auto
  then obtain d2 where "0 < d2" and
    d2_neg: "y t. (y, t)  cball (x, 0) d2  0 < t  (Ds (flow0 y t)) (f (flow0 y t)) < 0"
    and d2_ex: "y t. (y, t)  cball (x, 0) d2  0 < t  t  existence_ivl0 y"
    and d2_ex0: "y t. (y, t::real)  cball (x, 0) d2  0 < t  y  X"
    by (auto simp: eventually_at_le dist_commute)
  define d where "d  d2 / 2"
  from 0 < d2 have "d > 0" by (simp add: d_def)
  have d_neg: "dist y x< d  0 < t  t  d  (Ds (flow0 y t)) (f (flow0 y t)) < 0" for y t
    using d2_neg[of y t, OF subsetD[OF cball_times_subset[of x d2 0]]]
    by (auto simp: d_def dist_commute)
  have d_ex: "t  existence_ivl0 y" if "dist y x< d" "0  t" "t  d" for y t
  proof cases
    assume "t = 0"
    have "sqrt ((dist x y)2 + (d2 / 2)2)  dist x y + d2/2"
      using 0 < d2
      by (intro sqrt_sum_squares_le_sum) auto
    also have "dist x y  d2 / 2"
      using that by (simp add: d_def dist_commute)
    finally have "sqrt ((dist x y)2 + (d2 / 2)2)  d2" by simp
    with t = 0 show ?thesis
      using d2_ex[of y t, OF subsetD[OF cball_times_subset[of x d2 0]]] d2_ex0[of y d] 0 < d2
      by (auto simp: d_def dist_commute dist_prod_def)
  next
    assume "t  0"
    then show ?thesis
      using d2_ex[of y t, OF subsetD[OF cball_times_subset[of x d2 0]]] that
      by (auto simp: d_def dist_commute)
  qed
  have d_mvt: "s (flow0 y t) < s y" if "0 < t" "t  d" "dist y x < d" for y t
  proof -
    have c: "continuous_on {0 .. t} (λt. s (flow0 y t))"
      using that
      by (auto intro!: continuous_intros d_ex)
    have d: "x. 0 < x; x < t  ((λt. s (flow0 y t)) has_derivative (λt. t * blinfun_apply (Ds (flow0 y x)) (f (flow0 y x)))) (at x)"
      using that
      by (auto intro!: derivative_eq_intros d_ex simp: flowderiv_def blinfun.bilinear_simps)
    from mvt[OF 0 < t c d]
    obtain xi where xi: "0 < xi" "xi < t" and "s (flow0 y t) - s (flow0 y 0) = t * blinfun_apply (Ds (flow0 y xi)) (f (flow0 y xi))"
      by auto
    note this(3)
    also have " < 0"
      using 0 < t
      apply (rule mult_pos_neg)
      apply (rule d_neg)
      using that xi by auto
    also have "flow0 y 0 = y"
      apply (rule flow_initial_time)
      apply auto
      using 0 < d d_ex that(3) by fastforce
    finally show ?thesis
      by (auto simp: )
  qed
  obtain u eu where u:
      "s (flow0 x (u x)) = 0"
      "u x = return_time ?P x"
      "(y. y  cball x eu  s (flow0 y (u y)) = 0)"
      "continuous_on (cball x eu) u"
      "(λt. (t, u t)) ` cball x eu  Sigma X existence_ivl0"
      "0 < eu"
    by (rule returns_to_implicit_function[OF rt cS(1) Ds DsC through]; blast)
  have u_tendsto: "(u  u x) (at x)"
    unfolding isCont_def[symmetric]
    apply (rule continuous_on_interior[OF u(4)])
    using 0 < eu by auto
  have "u x > 0" by (auto simp: u intro!: return_time_pos rt)
  from order_tendstoD(1)[OF u_tendsto this] have "F x in at x. 0 < u x" .
  moreover have "F y in at x. y  cball x eu"
    using eventually_at_ball[OF 0 < eu, of x]
    by eventually_elim auto
  moreover
  have "x  S  s x  0  blinfun_apply (Ds x) (f x)  0" using inside by auto
  have returns: "F y in at x. returns_to ?P y"
    by (rule eventually_returns_to; fact)
  moreover
  have "F y in at x. y  ball x eu"
    using eventually_at_ball[OF 0 < eu]
    by eventually_elim simp
  then have ev_cball: "F y in at x. y  cball x eu"
    by eventually_elim (use e > 0 in auto)
  have "continuous_on (ball x eu) u"
    using u by (auto simp: continuous_on_subset)
  then have [tendsto_intros]: "(u  u x) (at x)"
    using eu > 0 at_within_open[of y "ball x eu" for y]
    by (auto simp: continuous_on_def)
  then have flow0_u_tendsto: "(λx. flow0 x (u x)) x poincare_map ?P x"
    by (auto intro!: tendsto_eq_intros u return_time_exivl rt simp: poincare_map_def)
  have s_imp: "s (poincare_map {x  S. s x = 0} x) = 0  poincare_map {x  S. s x = 0} x  S"
    using poincare_map_returns[OF rt]
    by auto
  from eventually_tendsto_compose_within[OF eventually_inside s_imp flow0_u_tendsto]
  have "F x in at x. s (flow0 x (u x)) = 0  flow0 x (u x)  S" by auto
  with ev_cball
  have "F x in at x. flow0 x (u x)  S"
    by eventually_elim (auto simp: u)
  ultimately have u_returns_ge: "F y in at x. returns_to ?P y  return_time ?P y  u y"
  proof eventually_elim
    case (elim y)
    then show ?case
      using u elim by (auto intro!: return_time_le[OF _ cls])
  qed
  moreover
  have "F y in at x. u y - return_time ?P x < e"
    using tendstoD[OF u_tendsto 0 < e, unfolded u] u_returns_ge
    by eventually_elim (auto simp: dist_real_def)
  moreover
  have d_less: "d < return_time ?P x"
    apply (rule return_time_gt)
      apply fact apply fact
    subgoal for t
      using d_mvt[of t x] s x = 0 0 < d
      by auto
    done
  note 1 = inside
  define ml where "ml = Max {return_time ?P x / 2, return_time ?P x - e, d}"
  have [intro, simp, arith]: "0 < ml" "ml < return_time ?P x" "ml  return_time ?P x" "d  ml"
    using return_time_pos[OF rt cls] 0 < e d_less
    by (auto simp: ml_def)
  have mt_in: "ml  existence_ivl0 x"
    using 0 < e 0 < d d_less
    by (auto intro!: mem_existence_ivl_iv_defined in_existence_between_zeroI[OF ret_exivl]
        simp: closed_segment_eq_real_ivl ml_def)
  from open_existence_ivlE[OF mt_in]
  obtain e0 where e0: "e0 > 0" "cball x e0 × {0..ml + e0}  Sigma X existence_ivl0" (is "?D  _")
    by auto
  have uc: "uniformly_continuous_on ((λ(x, t). flow0 x t) ` ?D) s"
    apply (auto intro!: compact_uniformly_continuous continuous_on_subset[OF cont_s])
    apply (rule compact_continuous_image)
     apply (rule continuous_on_subset)
      apply (rule flow_continuous_on_state_space)
     apply (rule e0)
    apply (rule compact_Times)
     apply (rule compact_cball)
    apply (rule compact_Icc)
    done
  let ?T = "{d..ml}"
  have ul: "uniform_limit ?T flow0 (flow0 x) (at x)"
    using 0 < e 0 < d d_less
    by (intro uniform_limit_flow)
      (auto intro!: mem_existence_ivl_iv_defined in_existence_between_zeroI[OF ret_exivl]
        simp: closed_segment_eq_real_ivl )
  {
    have "F y in at x within {x. s x  0}. y  X"
      by (rule topological_tendstoD[OF tendsto_ident_at open_dom x  X])
    moreover
    have "F y in at x within {x. s x  0}. s y  0"
      by (auto simp: eventually_at)
    moreover
    have "F y in at x within {x. s x  0}. Ds y (f y) < 0"
      by (rule order_tendstoD) (auto intro!: tendsto_eq_intros inside)
    moreover
    from tendstoD[OF tendsto_ident_at 0 < d]
    have "F y in at x within {x. s x  0}. dist y x < d"
      by (auto simp: )
    moreover
    have "d  existence_ivl0 x"
      using d_ex[of x d] 0 < d by auto
    have dret: "returns_to {xS. s x = 0} (flow0 x d)"
      apply (rule returns_to_laterI)
          apply fact+
      subgoal for u
        using d_mvt[of u x] s x = 0
        by auto
      done
    have "F y in at x. t{d..ml}. flow0 y t  - {x  S. s x = 0}"
      apply (rule uniform_limit_in_open)
           apply (rule ul)
          apply (auto intro!: continuous_intros continuous_on_compose2[OF cont_s] simp:
          split: if_splits)
      using d  existence_ivl0 x mem_is_interval_1_I mt_in apply blast
      subgoal for t
        using return_time_least[OF rt cls, of t] ml < return_time {x  S. s x = 0} x 0 < d
        by auto
      done
    then have "F y in at x within {x. s x  0}. t{d .. ml}. flow0 y t  - {x  S. s x = 0}"
      by (auto simp add: eventually_at; force)
    ultimately
    have "F y in at x within {x. s x  0}. t{0<..ml}. flow0 y t  - {x  S. s x = 0}"
      apply eventually_elim
      apply auto
      using d_mvt
      by fastforce
    moreover
    have "F y in at x. returns_to ?P y"
      by fact
    then have "F y in at x within {x. s x  0}. returns_to ?P y"
      by (auto simp: eventually_at)
    ultimately
    have "F y in at x within {x. s x  0}. return_time ?P y > ml"
      apply eventually_elim
      apply (rule return_time_gt)
      by auto
  }
  then have "F y in at x within {x. s x  0}. return_time ?P y  return_time ?P x - e"
    by eventually_elim (auto simp: ml_def)
  ultimately
  have "F y in at x within {x . s x  0}. dist (return_time ?P y) (return_time ?P x)  e"
    unfolding eventually_at_filter
    by eventually_elim (auto simp: dist_real_def abs_real_def algebra_simps)
  then show "F y in at x within {x. s x  0}. dist (return_time ?P y) (return_time ?P x) < e_orig"
    by eventually_elim (use e_orig > 0 in auto simp: e_def›)
qed

lemma
  return_time_continuous_below_plane:
  fixes s::"'a::euclidean_space  real"
  assumes rt: "returns_to {x  R. x  n = c} x" (is "returns_to ?P x")
  assumes cR: "closed R"
  assumes through: "f (poincare_map ?P x)  n  0"
  assumes R: "x  R"
  assumes inside: "x  n = c" "f x  n < 0"
  assumes eventually_inside: "F x in at (poincare_map ?P x). x  n = c  x  R"
  shows "continuous (at x within {x. x  n  c}) (return_time ?P)"
  apply (rule return_time_continuous_below[of R "λx. x  n - c", simplified])
  using through rt inside cR R eventually_inside
  by (auto intro!: derivative_eq_intros blinfun_inner_left.rep_eq[symmetric])

lemma
  poincare_map_in_interior_eventually_return_time_equal:
  assumes RP: "R  P"
  assumes cP: "closed P"
  assumes cR: "closed R"
  assumes ret: "returns_to P x"
  assumes evret: "F x in at x within S. returns_to P x"
  assumes evR: "F x in at x within S. poincare_map P x  R"
  shows "F x in at x within S. returns_to R x  return_time P x = return_time R x"
proof -
  from evret evR
  show ?thesis
  proof eventually_elim
    case (elim x)
    from return_time_least[OF elim(1) cP] RP
    have rtl: "s. 0 < s  s < return_time P x  flow0 x s  R"
      by auto
    from elim(2) have pR: "poincare_map P x  R"
      by auto
    have "F t in at_right 0. 0 < t"
      by (simp add: eventually_at_filter)
    moreover have "F t in at_right 0. t < return_time P x"
      using return_time_pos[OF elim(1) cP]
      by (rule order_tendstoD[OF tendsto_ident_at])
    ultimately have evR: "F t in at_right 0. flow0 x t  R"
    proof eventually_elim
      case et: (elim t)
      from return_time_least[OF elim(1) cP et] show ?case using RP by auto
    qed
    have rtp: "0 < return_time P x" by (intro return_time_pos cP elim)
    have rtex: "return_time P x  existence_ivl0 x" by (intro return_time_exivl elim cP)
    have frR: "flow0 x (return_time P x)  R"
      unfolding poincare_map_def[symmetric] by (rule pR)
    have "returns_to R x"
      by (rule returns_toI[where t="return_time P x"]; fact)
    moreover have "return_time R x = return_time P x"
      by (rule return_time_eqI) fact+
    ultimately show ?case by auto
  qed
qed

lemma poincare_map_in_planeI:
  assumes "returns_to (plane n c) x0"
  shows "poincare_map (plane n c) x0  n = c"
  using poincare_map_returns[OF assms]
  by fastforce

lemma less_return_time_imp_exivl:
  "h  existence_ivl0 x'" if "h  return_time P x'" "returns_to P x'" "closed P" "0  h"
proof -
  from return_time_exivl[OF that(2,3)]
  have "return_time P x'  existence_ivl0 x'" by auto
  from ivl_subset_existence_ivl[OF this] that show ?thesis
    by auto
qed

lemma eventually_returns_to_continuousI:
  assumes "returns_to P x"
  assumes "closed P"
  assumes "continuous (at x within S) (return_time P)"
  shows "F x in at x within S. returns_to P x"
proof -
  have "return_time P x > 0"
    using assms by (auto simp: return_time_pos)
  from order_tendstoD(1)[OF assms(3)[unfolded continuous_within] this]
  have "F x in at x within S. 0 < return_time P x" .
  then show ?thesis
    by eventually_elim (auto simp: return_time_pos_returns_to)
qed

lemma return_time_implicit_functionE:
  fixes s::"'a::euclidean_space  real"
  assumes rt: "returns_to {x  S. s x = 0} x" (is "returns_to ?P _")
  assumes cS: "closed S"
  assumes Ds: "x. (s has_derivative blinfun_apply (Ds x)) (at x)"
  assumes DsC: "x. isCont Ds x"
  assumes Ds_through: "(Ds (poincare_map ?P x)) (f (poincare_map ?P x))  0"
  assumes eventually_inside: "F x in at (poincare_map ?P x). s x = 0  x  S"
  assumes outside: "x  S  s x  0"
  obtains e' where
    "0 < e'"
    "y. y  ball x e'  returns_to ?P y"
    "y. y  ball x e'  s (flow0 y (return_time ?P y)) = 0"
    "continuous_on (ball x e') (return_time ?P)"
    "(y. y  ball x e'  Ds (poincare_map ?P y) oL flowderiv y (return_time ?P y) oL embed2_blinfun  invertibles_blinfun)"
    "(U v sa.
       (sa. sa  U  s (flow0 sa (v sa)) = 0) 
       return_time ?P x = v x 
       continuous_on U v  sa  U  x  U  U  ball x e'  connected U  open U  return_time ?P sa = v sa)"
    "(return_time ?P has_derivative
        - blinfun_scaleR_left (inverse ((Ds (poincare_map ?P x)) (f (poincare_map ?P x)))) oL
              (Ds (poincare_map ?P x) oL Dflow x (return_time ?P x)))
            (at x)"
proof -
  have cont_s: "continuous_on UNIV s" by (rule has_derivative_continuous_on[OF Ds])
  then have s_tendsto: "(s  s x) (at x)" for x
    by (auto simp: continuous_on_def)
  have cls[simp, intro]: "closed {x  S. s x = 0}"
    by (rule closed_levelset_within) (auto intro!: cS continuous_on_subset[OF cont_s])

  have cont_Ds: "continuous_on UNIV Ds"
    using DsC by (auto simp: continuous_on_def isCont_def)
  note [tendsto_intros] = continuous_on_tendsto_compose[OF cont_Ds _ UNIV_I, simplified]
  note [continuous_intros] = continuous_on_compose2[OF cont_Ds _ subset_UNIV]

  have "F x in at (poincare_map ?P x). s x = 0  x  S"
    using eventually_inside
    by auto
  then obtain U where "open U" "poincare_map ?P x  U" "x. x  U  s x = 0  x  S"
    using poincare_map_returns[OF rt cls]
    by (force simp: eventually_at_topological)
  have s_imp: "s (poincare_map ?P x) = 0  poincare_map ?P x  S"
    using poincare_map_returns[OF rt cls]
    by auto
  have outside_disj: "x  S  s x  0  blinfun_apply (Ds x) (f x)  0"
    using outside by auto
  have pm_tendsto: "(poincare_map ?P  poincare_map ?P x) (at x)"
    apply (rule poincare_map_tendsto)
    unfolding isCont_def[symmetric]
      apply (rule return_time_isCont_outside)
    using assms
    by (auto intro!: cls )
  have evmemS: "F x in at x. poincare_map ?P x  S"
    using eventually_returns_to[OF rt cS Ds DsC eventually_inside Ds_through outside_disj]
    apply eventually_elim
    using poincare_map_returns
    by auto
  have "F x in at x. F x in at (poincare_map ?P x). s x = 0  x  S"
    apply (rule eventually_tendsto_compose_within[OF _ _ pm_tendsto])
      apply (rule eventually_eventually_withinI)
       apply (rule eventually_inside)
      apply (rule s_imp)
     apply (rule eventually_inside)
    apply (rule evmemS)
    done
  moreover
  have "eventually (λx. x  - ?P) (at x)"
    apply (rule topological_tendstoD)
    using outside
    by (auto intro!: )
  then have "eventually (λx. x  S  s x  0) (at x)"
    by auto
  moreover
  have "eventually (λx. (Ds (poincare_map ?P x)) (f (poincare_map ?P x))  0) (at x)"
    apply (rule tendsto_imp_eventually_ne)
     apply (rule tendsto_intros)
     apply (rule tendsto_intros)
    unfolding poincare_map_def
      apply (rule tendsto_intros)
        apply (rule tendsto_intros)
       apply (subst isCont_def[symmetric])
       apply (rule return_time_isCont_outside[OF rt cS Ds DsC Ds_through eventually_inside outside])
      apply (rule return_time_exivl[OF rt cls])
      apply (rule tendsto_intros)
        apply (rule tendsto_intros)
        apply (rule tendsto_intros)
       apply (subst isCont_def[symmetric])
       apply (rule return_time_isCont_outside[OF rt cS Ds DsC Ds_through eventually_inside outside])
      apply (rule return_time_exivl[OF rt cls])
     apply (rule flow_in_domain)
     apply (rule return_time_exivl[OF rt cls])
    unfolding poincare_map_def[symmetric]
    apply (rule Ds_through)
    done
  ultimately
  have "eventually (λy. returns_to ?P y  (F x in at (poincare_map ?P y). s x = 0  x  S) 
    (y  S  s y  0)  (Ds (poincare_map ?P y)) (f (poincare_map ?P y))  0) (at x)"
    using eventually_returns_to[OF rt cS Ds DsC eventually_inside Ds_through outside_disj]
    by eventually_elim auto
  then obtain Y' where Y': "open Y'" "x  Y'" "y. y  Y'  returns_to ?P y"
      "y. y  Y'  (F x in at (poincare_map ?P y). s x = 0  x  S)"
      "y. y  Y'  y  S  s y  0"
      "y. y  Y'  blinfun_apply (Ds (poincare_map ?P y)) (f (poincare_map ?P y))  0"
    apply (subst (asm) (3) eventually_at_topological)
    using rt outside Ds_through eventually_inside
    by fastforce
  from openE[OF ‹open Y' x  Y'] obtain eY where eY: "0 < eY" "ball x eY  Y'" by auto
  define Y where "Y = ball x eY"
  then have Y: "open Y" and x: "x  Y"
      and Yr: "y. y  Y  returns_to ?P y"
      and Y_mem: "y. y  Y  (F x in at (poincare_map ?P y). s x = 0  x  S)"
      and Y_nz: "y. y  Y  y  S  s y  0"
      and Y_fnz: "y. y  Y  Ds (poincare_map ?P y) (f (poincare_map ?P y))  0"
      and Y_convex: "convex Y"
    using Y' eY
    by (auto simp: subset_iff dist_commute)
  have "isCont (return_time ?P) y" if "y  Y" for y
    using return_time_isCont_outside[OF Yr[OF that] cS Ds DsC Y_fnz Y_mem Y_nz, OF that that that] .
  then have cY: "continuous_on Y (return_time ?P)"
    by (auto simp: continuous_on_def isCont_def Lim_at_imp_Lim_at_within)

  note [derivative_intros] = has_derivative_compose[OF _ Ds]
  let ?t1 = "return_time ?P x"
  have t1_exivl: "?t1  existence_ivl0 x"
    by (auto intro!: return_time_exivl rt)
  then have [simp]: "x  X" by auto
  have xt1: "(x, ?t1)  Sigma Y existence_ivl0"
    by (auto intro!: return_time_exivl rt x)
  have "Sigma Y existence_ivl0 = Sigma X existence_ivl0  fst -` Y" by auto
  also have "open "
    by (rule open_Int[OF open_state_space open_vimage_fst[OF ‹open Y]])
  finally have "open (Sigma Y existence_ivl0)" .
  have D: "(x. x  Sigma Y existence_ivl0 
      ((λ(x, t). s (flow0 x t)) has_derivative
       blinfun_apply (Ds (flow0 (fst x) (snd x)) oL (flowderiv (fst x) (snd x))))
       (at x))"
    by (auto intro!: derivative_eq_intros)
  have C: "continuous_on (Sigma Y existence_ivl0) (λx. Ds (flow0 (fst x) (snd x)) oL flowderiv (fst x) (snd x))"
    by (auto intro!: continuous_intros)
  from return_time_returns[OF rt cls]
  have Z: "(case (x, ?t1) of (x, t)  s (flow0 x t)) = 0"
    by (auto simp: x)
  have I1: "blinfun_scaleR_left (inverse (Ds (flow0 x (?t1))(f (flow0 x (?t1))))) oL 
    ((Ds (flow0 (fst (x, return_time ?P x))
            (snd (x, return_time ?P x))) oL
       flowderiv (fst (x, return_time ?P x))
        (snd (x, return_time ?P x))) oL
      embed2_blinfun)
     = 1L"
    using Ds_through
    by (auto intro!: blinfun_eqI
        simp: rt flowderiv_def blinfun.bilinear_simps inverse_eq_divide poincare_map_def)
  have I2: "((Ds (flow0 (fst (x, return_time ?P x))
            (snd (x, return_time ?P x))) oL
       flowderiv (fst (x, return_time ?P x))
        (snd (x, return_time ?P x))) oL
      embed2_blinfun) oL blinfun_scaleR_left (inverse (Ds (flow0 x (?t1))(f (flow0 x (?t1)))))
     = 1L"
    using Ds_through
    by (auto intro!: blinfun_eqI
        simp: rt flowderiv_def blinfun.bilinear_simps inverse_eq_divide poincare_map_def)
  obtain u e where u:
      "s (flow0 x (u x)) = 0"
       "u x = return_time ?P x"
       "(sa. sa  cball x e  s (flow0 sa (u sa)) = 0)"
       "continuous_on (cball x e) u"
       "(λt. (t, u t)) ` cball x e  Sigma Y existence_ivl0"
       "0 < e"
       "(u has_derivative
            blinfun_apply
             (- blinfun_scaleR_left
                 (inverse (blinfun_apply (Ds (poincare_map ?P x)) (f (poincare_map ?P x)))) oL
              (Ds (poincare_map ?P x) oL flowderiv x (return_time ?P x)) oL
              embed1_blinfun))
            (at x)"
       "(s. s  cball x e 
         Ds (flow0 s (u s)) oL flowderiv s (u s) oL embed2_blinfun  invertibles_blinfun)"
      and unique: "(U v sa.
               (sa. sa  U  s (flow0 sa (v sa)) = 0) 
               u x = v x 
               continuous_on U v  sa  U  x  U  U  cball x e  connected U  open U  u sa = v sa)"
    apply (rule implicit_function_theorem_unique[where f="λ(x, t). s (flow0 x t)"
          and S="Sigma Y existence_ivl0", OF D xt1 ‹open (Sigma Y _) order_refl C Z I1 I2])
     apply blast
    unfolding split_beta' fst_conv snd_conv poincare_map_def[symmetric]
    apply (rule)
    by (assumption+, blast)
  have u_rt: "u y = return_time ?P y" if "y  ball x e  Y" for y
    apply (rule unique[of "ball x e  Y" "return_time ?P"])
    subgoal for y
      unfolding poincare_map_def[symmetric]
      using poincare_map_returns[OF Yr cls]
      by auto
    subgoal by (auto simp: u)
    subgoal using cY by (rule continuous_on_subset) auto
    subgoal using that by auto
    subgoal using x 0 < e by auto
    subgoal by auto
    subgoal
      apply (rule convex_connected)
      apply (rule convex_Int)
       apply simp
      apply fact
      done
    subgoal by (auto intro!: open_Int ‹open Y)
    done

  have *: "(- blinfun_scaleR_left
                 (inverse (blinfun_apply (Ds (poincare_map ?P x)) (f (poincare_map ?P x)))) oL
              (Ds (poincare_map ?P x) oL flowderiv x (return_time ?P x)) oL
              embed1_blinfun) =
    - blinfun_scaleR_left (inverse (blinfun_apply (Ds (poincare_map ?P x)) (f (poincare_map ?P x)))) oL
              (Ds (poincare_map ?P x) oL Dflow x (return_time ?P x))"
    by (auto intro!: blinfun_eqI simp: flowderiv_def)
  define e' where "e' = min e eY"
  have e'_eq: "ball x e' = ball x e  Y" by (auto simp: e'_def Y_def)
  have
    "0 < e'"
    "y. y  ball x e'  returns_to ?P y"
    "y. y  ball x e'  s (flow0 y (return_time ?P y)) = 0"
    "continuous_on (ball x e') (return_time ?P)"
    "(y. y  ball x e'  Ds (poincare_map ?P y) oL flowderiv y (return_time ?P y) oL embed2_blinfun  invertibles_blinfun)"
    "(U v sa.
       (sa. sa  U  s (flow0 sa (v sa)) = 0) 
       return_time ?P x = v x 
       continuous_on U v  sa  U  x  U  U  ball x e'  connected U  open U  return_time ?P sa = v sa)"
    "(return_time ?P has_derivative blinfun_apply
             (- blinfun_scaleR_left
                 (inverse (blinfun_apply (Ds (poincare_map ?P x)) (f (poincare_map ?P x)))) oL
              (Ds (poincare_map ?P x) oL flowderiv x (return_time ?P x)) oL
              embed1_blinfun))
            (at x)"
    unfolding e'_eq
    subgoal by (auto simp: e'_def 0 < e 0 < eY)
    subgoal by (rule Yr) auto
    subgoal for y
      unfolding poincare_map_def[symmetric]
      using poincare_map_returns[OF Yr cls]
      by auto
    subgoal using cY by (rule continuous_on_subset) auto
    subgoal premises prems for y
      unfolding poincare_map_def
      unfolding u_rt[OF prems, symmetric]
      apply (rule u)
      using prems by auto
    subgoal premises prems for U v t
      apply (subst u_rt[symmetric])
      subgoal using prems by force
      apply (rule unique[of U v])
      subgoal by fact
      subgoal by (auto simp: u prems)
      subgoal by fact
      subgoal by fact
      subgoal by fact
      subgoal using prems by auto
      subgoal by fact
      subgoal by fact
      done
    subgoal
    proof -
      have "F x' in at x. x'  ball x e'"
        using eventually_at_ball[OF 0 < e']
        by eventually_elim simp
      then have "F x' in at x. u x' = return_time ?P x'"
        unfolding e'_eq
        by eventually_elim (rule u_rt, auto)
      from u(7) this
      show ?thesis
        by (rule has_derivative_transform_eventually) (auto simp: u)
    qed
    done
  then show ?thesis unfolding * ..
qed

lemma return_time_has_derivative:
  fixes s::"'a::euclidean_space  real"
  assumes rt: "returns_to {x  S. s x = 0} x" (is "returns_to ?P _")
  assumes cS: "closed S"
  assumes Ds: "x. (s has_derivative blinfun_apply (Ds x)) (at x)"
  assumes DsC: "x. isCont Ds x"
  assumes Ds_through: "(Ds (poincare_map ?P x)) (f (poincare_map ?P x))  0"
  assumes eventually_inside: "F x in at (poincare_map {x  S. s x = 0} x). s x = 0  x  S"
  assumes outside: "x  S  s x  0"
  shows "(return_time ?P has_derivative
  - blinfun_scaleR_left (inverse ((Ds (poincare_map ?P x)) (f (poincare_map ?P x)))) oL
      (Ds (poincare_map ?P x) oL Dflow x (return_time ?P x)))
            (at x)"
  using return_time_implicit_functionE[OF assms] by blast

lemma return_time_plane_has_derivative_blinfun:
  assumes rt: "returns_to {x  S. x  i = c} x" (is "returns_to ?P _")
  assumes cS: "closed S"
  assumes fnz: "f (poincare_map ?P x)  i  0"
  assumes eventually_inside: "F x in at (poincare_map ?P x). x  i = c  x  S"
  assumes outside: "x  S  x  i  c"
  shows "(return_time ?P has_derivative
    (- blinfun_scaleR_left (inverse ((blinfun_inner_left i) (f (poincare_map ?P x)))) oL
      (blinfun_inner_left i oL Dflow x (return_time ?P x)))) (at x)"
proof -
  have rt: "returns_to {x  S. x  i - c = 0} x"
    using rt by auto
  have D: "((λx. x  i - c) has_derivative blinfun_inner_left i) (at x)" for x
    by (auto intro!: derivative_eq_intros)
  have DC: "(x. isCont (λx. blinfun_inner_left i) x)"
    by (auto intro!: continuous_intros)
  have nz: "blinfun_apply (blinfun_inner_left i) (f (poincare_map {x  S. x  i - c = 0} x))  0"
    using fnz by (auto )
  from cS have cS: "closed S"by auto
  have out: "x  S  x  i - c  0" using outside by simp
  from eventually_inside
  have eventually_inside: "F x in at (poincare_map {x  S. x  i - c = 0} x). x  i - c = 0  x  S"
    by auto
  from return_time_has_derivative[OF rt cS D DC nz eventually_inside out]
  show ?thesis
    by auto
qed

lemma return_time_plane_has_derivative:
  assumes rt: "returns_to {x  S. x  i = c} x" (is "returns_to ?P _")
  assumes cS: "closed S"
  assumes fnz: "f (poincare_map ?P x)  i  0"
  assumes eventually_inside: "F x in at (poincare_map ?P x). x  i = c  x  S"
  assumes outside: "x  S  x  i  c"
  shows "(return_time ?P has_derivative
    (λh. - (Dflow x (return_time ?P x)) h  i / (f (poincare_map ?P x)  i))) (at x)"
  by (rule return_time_plane_has_derivative_blinfun[OF assms, THEN has_derivative_eq_rhs])
    (auto simp: blinfun.bilinear_simps flowderiv_def inverse_eq_divide intro!: ext)

definition "Dpoincare_map i c S x =
  (λh. (Dflow x (return_time {x  S. x  i = c} x)) h -
      ((Dflow x (return_time {x  S. x  i = c} x)) h  i /
        (f (poincare_map {x  S. x  i = c} x)  i)) *R f (poincare_map {x  S. x  i = c} x))"

definition "Dpoincare_map' i c S x =
  Dflow x (return_time {x  S. x  i - c = 0} x) -
  (blinfun_scaleR_left (f (poincare_map {x  S. x  i = c} x)) oL
    (blinfun_scaleR_left (inverse ((f (poincare_map {x  S. x  i = c} x)  i))) oL
    (blinfun_inner_left i oL Dflow x (return_time {x  S. x  i - c = 0} x))))"

theorem poincare_map_plane_has_derivative:
  assumes rt: "returns_to {x  S. x  i = c} x" (is "returns_to ?P _")
  assumes cS: "closed S"
  assumes fnz: "f (poincare_map ?P x)  i  0"
  assumes eventually_inside: "F x in at (poincare_map ?P x). x  i = c  x  S"
  assumes outside: "x  S  x  i  c"
  notes [derivative_intros] = return_time_plane_has_derivative[OF rt cS fnz eventually_inside outside]
  shows "(poincare_map ?P has_derivative Dpoincare_map' i c S x) (at x)"
  unfolding poincare_map_def Dpoincare_map'_def
  using fnz outside
  by (auto intro!: derivative_eq_intros return_time_exivl assms ext closed_levelset_within
      continuous_intros
      simp: flowderiv_eq poincare_map_def blinfun.bilinear_simps inverse_eq_divide algebra_simps)

end

end

Theory Reachability_Analysis

theory Reachability_Analysis
imports
  Flow
  Poincare_Map
begin

lemma not_mem_eq_mem_not: "a  A  a  - A"
  by auto

lemma continuous_orderD:
  fixes g::"'b::t2_space  'c::order_topology"
  assumes "continuous (at x within S) g"
  shows "g x > c  F y in at x within S. g y > c"
    "g x < c  F y in at x within S. g y < c"
  using order_tendstoD[OF assms[unfolded continuous_within]]
  by auto

lemma frontier_halfspace_component_ge: "n  0  frontier {x. c  x  n} = plane n c"
  apply (subst (1) inner_commute)
  apply (subst (2) inner_commute)
  apply (subst frontier_halfspace_ge[of n c])
  by auto

lemma closed_Collect_le_within:
  fixes f g :: "'a :: topological_space  'b::linorder_topology"
  assumes f: "continuous_on UNIV f"
    and g: "continuous_on UNIV g"
    and "closed R"
  shows "closed {x  R. f x  g x}"
proof -
  have *: "- R  {x. g x < f x} = - {x  R. f x  g x}"
    by auto
  have "open (-R)" using assms by auto
  from open_Un[OF this open_Collect_less [OF g f], unfolded *]
  show ?thesis
    by (simp add: closed_open)
qed

subsection ‹explicit representation of hyperplanes / halfspaces›

datatype 'a sctn = Sctn (normal: 'a) (pstn: real)

definition "le_halfspace sctn x  x  normal sctn  pstn sctn"

definition "lt_halfspace sctn x  x  normal sctn < pstn sctn"

definition "ge_halfspace sctn x  x  normal sctn  pstn sctn"

definition "gt_halfspace sctn x  x  normal sctn > pstn sctn"

definition "plane_of sctn = {x. x  normal sctn = pstn sctn}"

definition "above_halfspace sctn = Collect (ge_halfspace sctn)"

definition "below_halfspace sctn = Collect (le_halfspace sctn)"

definition "sbelow_halfspace sctn = Collect (lt_halfspace sctn)"

definition "sabove_halfspace sctn = Collect (gt_halfspace sctn)"


subsection ‹explicit H representation of polytopes (mind Polytopes.thy›)›

definition below_halfspaces
where "below_halfspaces sctns = (below_halfspace ` sctns)"

definition sbelow_halfspaces
where "sbelow_halfspaces sctns = (sbelow_halfspace ` sctns)"

definition above_halfspaces
where "above_halfspaces sctns = (above_halfspace ` sctns)"

definition sabove_halfspaces
where "sabove_halfspaces sctns = (sabove_halfspace ` sctns)"

lemmas halfspace_simps =
  above_halfspace_def
  sabove_halfspace_def
  below_halfspace_def
  sbelow_halfspace_def
  below_halfspaces_def
  sbelow_halfspaces_def
  above_halfspaces_def
  sabove_halfspaces_def
  ge_halfspace_def[abs_def]
  gt_halfspace_def[abs_def]
  le_halfspace_def[abs_def]
  lt_halfspace_def[abs_def]

subsection ‹predicates for reachability analysis›

context c1_on_open_euclidean
begin

definition flowpipe ::
  "(('a::euclidean_space) × ('a L 'a)) set  real  real 
   ('a × ('a L 'a)) set  ('a × ('a L 'a)) set  bool"
where "flowpipe X0 hl hu CX X1  0  hl  hl  hu  fst ` X0  X  fst ` CX  X  fst ` X1  X 
  ((x0, d0)  X0. h  {hl .. hu}.
    h  existence_ivl0 x0  (flow0 x0 h, Dflow x0 h oL d0)  X1  (h'  {0 .. h}. (flow0 x0 h', Dflow x0 h' oL d0)  CX))"

lemma flowpipeD:
  assumes "flowpipe X0 hl hu CX X1"
  shows flowpipe_safeD: "fst ` X0  fst ` CX  fst ` X1  X"
    and flowpipe_nonneg: "0  hl" "hl  hu"
    and flowpipe_exivl: "hl  h  h  hu  (x0, d0)  X0  h  existence_ivl0 x0"
    and flowpipe_discrete: "hl  h  h  hu  (x0, d0)  X0  (flow0 x0 h, Dflow x0 h oL d0)  X1"
    and flowpipe_cont: "hl  h  h  hu  (x0, d0)  X0  0  h'  h'  h  (flow0 x0 h', Dflow x0 h' oL d0)  CX"
  using assms
  by (auto simp: flowpipe_def)

lemma flowpipe_source_subset: "flowpipe X0 hl hu CX X1  X0  CX"
  apply (auto dest: bspec[where x=hl] bspec[where x=0] simp: flowpipe_def)
  apply (drule bspec)
   apply (assumption)
  apply auto
  apply (drule bspec[where x=hl])
   apply auto
  apply (drule bspec[where x=0])
  by (auto simp: flow_initial_time_if)

definition "flowsto X0 T CX X1 
  ((x0, d0)  X0. h  T. h  existence_ivl0 x0  (flow0 x0 h, Dflow x0 h oL d0)  X1  (h'  open_segment 0 h. (flow0 x0 h', Dflow x0 h' oL d0)  CX))"

lemma flowsto_to_empty_iff[simp]: "flowsto a t b {}  a = {}"
  by (auto simp: simp: flowsto_def)

lemma flowsto_from_empty_iff[simp]: "flowsto {} t b c"
  by (auto simp: simp: flowsto_def)

lemma flowsto_empty_time_iff[simp]: "flowsto a {} b c  a = {}"
  by (auto simp: simp: flowsto_def)

lemma flowstoE:
  assumes "flowsto X0 T CX X1" "(x0, d0)  X0"
  obtains h where "h  T" "h  existence_ivl0 x0" "(flow0 x0 h, Dflow x0 h oL d0)  X1"
    "h'. h'  open_segment 0 h  (flow0 x0 h', Dflow x0 h' oL d0)  CX"
  using assms
  by (auto simp: flowsto_def)

lemma flowsto_safeD: "flowsto X0 T CX X1  fst ` X0  X"
  by (auto simp: flowsto_def split_beta' mem_existence_ivl_iv_defined)

lemma flowsto_union:
  assumes 1: "flowsto X0 T CX Y" and 2: "flowsto Z S CZ W"
  shows "flowsto (X0  Z) (T  S) (CX  CZ) (Y  W)"
  using assms unfolding flowsto_def
  by force

lemma flowsto_subset:
  assumes "flowsto X0 T CX Y"
  assumes "Z  X0" "T  S" "CX  CZ" "Y  W"
  shows "flowsto Z S CZ W"
  unfolding flowsto_def
  using assms
  by (auto elim!: flowstoE) blast

lemmas flowsto_unionI = flowsto_subset[OF flowsto_union]

lemma flowsto_unionE:
  assumes "flowsto X0 T CX (Y  Z)"
  obtains X1 X2 where "X0 = X1  X2" "flowsto X1 T CX Y" "flowsto X2 T CX Z"
proof -
  let ?X1 = "{xX0. flowsto {x} T CX Y}"
  let ?X2 = "{xX0. flowsto {x} T CX Z}"
  from assms have "X0 = ?X1  ?X2" "flowsto ?X1 T CX Y" "flowsto ?X2 T CX Z"
    by (auto simp: flowsto_def)
  thus ?thesis ..
qed

lemma flowsto_trans:
  assumes A: "flowsto A S B C" and C: "flowsto C T D E"
  shows "flowsto A {s + t |s t. s  S  t  T} (B  D  C) E"
  unfolding flowsto_def
proof safe
  fix x0 d0 assume x0: "(x0, d0)  A"
  from flowstoE[OF A x0]
  obtain h where h: "h  S" "h  existence_ivl0 x0" "(flow0 x0 h, (Dflow x0 h) oL d0)  C"
    "h'. h'  {0<--<h}  (flow0 x0 h', Dflow x0 h' oL d0)  B"
    by auto
  from h(2) have x0[simp]: "x0  X" by auto
  from flowstoE[OF C _  C]
  obtain i where i: "i  T" "i  existence_ivl0 (flow0 x0 h)"
    "(flow0 (flow0 x0 h) i, Dflow (flow0 x0 h) i oL Dflow x0 h oL d0)  E"
    "h'. h'  {0<--<i}  (flow0 (flow0 x0 h) h', Dflow (flow0 x0 h) h' oL (Dflow x0 h oL d0))  D"
    by (auto simp: ac_simps)
  have hi: "h + i  existence_ivl0 x0"
    using h  existence_ivl0 x0 i  existence_ivl0 (flow0 x0 h) existence_ivl_trans by blast
  moreover have "(flow0 x0 (h + i), Dflow x0 (h + i) oL d0)  E"
    apply (subst flow_trans)
      apply fact apply fact
    apply (subst Dflow_trans)
      apply fact apply fact
    apply fact
    done
  moreover have "(flow0 x0 h', Dflow x0 h' oL d0)  B  D  C" if "h'{0<--<h + i}" for h'
  proof cases
    assume "h'  {0 <--< h}"
    then show ?thesis using h by simp
  next
    assume "h'  {0 <--< h}"
    with that have h': "h' - h  {0 <--< i}" if "h'  h"
      using that
      by (auto simp: open_segment_eq_real_ivl closed_segment_eq_real_ivl split: if_splits)
    from i(4)[OF this]
    show ?thesis
      apply (cases "h' = h")
      subgoal using h by force
      subgoal
        apply simp
        apply (subst (asm) flow_trans[symmetric])
        subgoal by (rule h)
        subgoal using _  h' - h  {0<--<i} i(2) local.in_existence_between_zeroI
          apply auto
          using open_closed_segment by blast
        subgoal
          unfolding blinfun_compose_assoc[symmetric]
          apply (subst (asm) Dflow_trans[symmetric])
            apply auto
           apply fact+
          done
        done
      done
  qed
  ultimately show "h{s + t |s t. s  S  t  T}.
      h  existence_ivl0 x0  (flow0 x0 h, Dflow x0 h oL d0)  E  (h'{0<--<h}. (flow0 x0 h', Dflow x0 h' oL d0)  B  D  C)"
    using h  S i  T
    by (auto intro!: bexI[where x="h + i"])
qed

lemma flowsto_step:
  assumes A: "flowsto A S B C"
  assumes D: "flowsto D T E F"
  shows "flowsto A (S  {s + t |s t. s  S  t  T}) (B  E  C  D) (C - D  F)"
proof -
  have "C = (C  D)  (C - D)" (is "_ = ?C1  ?C2")
    by auto
  then have "flowsto A S B (?C1  ?C2)" using A by simp
  from flowsto_unionE[OF this]
  obtain A1 A2 where "A = A1  A2" and A1: "flowsto A1 S B ?C1" and A2: "flowsto A2 S B ?C2"
    by auto
  have "flowsto ?C1 T E F"
    using D by (rule flowsto_subset) auto
  from flowsto_union[OF flowsto_trans[OF A1 this] A2]
  show ?thesis by (auto simp add: A = _ ac_simps)
qed

lemma
  flowsto_stepI:
    "flowsto X0 U B C 
    flowsto D T E F 
    Z  X0 
    (s. s  U  s  S) 
    (s t. s  U  t  T  s + t  S) 
    B  E  D  C  CZ  C - D  F  W  flowsto Z S CZ W"
  by (rule flowsto_subset[OF flowsto_step]) auto

lemma flowsto_imp_flowsto:
  "flowpipe Y h h CY Z  flowsto Y {h} (CY) Z"
  unfolding flowpipe_def flowsto_def
  by (auto simp: open_segment_eq_real_ivl split_beta')

lemma connected_below_halfspace:
  assumes "x  below_halfspace sctn"
  assumes "x  S" "connected S"
  assumes "S  plane_of sctn = {}"
  shows "S  below_halfspace sctn"
proof -
  note ‹connected S
  moreover
  have "open {x. x  normal sctn < pstn sctn}" (is "open ?X")
    and "open {x. x  normal sctn > pstn sctn}" (is "open ?Y")
    by (auto intro!: open_Collect_less continuous_intros)
  moreover have "?X  ?Y  S = {}" "S  ?X  ?Y"
    using assms by (auto simp: plane_of_def)
  ultimately have "?X  S = {}  ?Y  S = {}"
    by (rule connectedD)
  then show ?thesis
    using assms
    by (force simp: below_halfspace_def le_halfspace_def plane_of_def)
qed

lemma
  inter_Collect_eq_empty:
  assumes "x. x  X0  ¬ g x" shows "X0  Collect g = {}"
  using assms by auto


subsection ‹Poincare Map›

lemma closed_plane_of[simp]: "closed (plane_of sctn)"
  by (auto simp: plane_of_def intro!: closed_Collect_eq continuous_intros)

definition "poincare_mapsto P X0 S CX Y  ((x, d)  X0.
  returns_to P x  fst ` X0  S 
  (return_time P differentiable at x within S) 
  (D. (poincare_map P has_derivative blinfun_apply D) (at x within S) 
       (poincare_map P x, D oL d)  Y) 
  (t{0<..<return_time P x}. flow0 x t  CX))"

lemma poincare_mapsto_empty[simp]:
  "poincare_mapsto P {} S CX Y"
  by (auto simp: poincare_mapsto_def)

lemma flowsto_eventually_mem_cont:
  assumes "flowsto X0 T CX Y" "(x, d)  X0" "T  {0<..}"
  shows "F t in at_right 0. (flow0 x t, Dflow x t oL d)  CX"
proof -
  from flowstoE[OF assms(1,2)] assms(3)
  obtain h where h: "0 < h" "h  T" "h  existence_ivl0 x" "(flow0 x h, (Dflow x h) oL d)  Y" "h'. h'  {0<--<h}  (flow0 x h', (Dflow x h') oL d)  CX"
    by (auto simp: subset_iff)
  have "F x in at_right 0. 0 < x  x < h"
    apply (rule eventually_conj[OF eventually_at_right_less])
    using eventually_at_right h(1) by blast
  then show ?thesis
    by eventually_elim (auto intro!: h simp: open_segment_eq_real_ivl)
qed

lemma frontier_aux_lemma:
  fixes R :: "'n::euclidean_space set"
  assumes "closed R" "R  {x. x  n = c}" and [simp]: "n  0"
  shows "frontier {x  R. c  x  n} = {x  R. c = x  n}"
  apply (auto simp: frontier_closures)
  subgoal by (metis (full_types) Collect_subset assms(1) closure_minimal subsetD)
  subgoal premises prems for x
  proof -
    note prems
    have "closed {x  R. c  x  n}"
      by (auto intro!: closed_Collect_le_within continuous_intros assms)
    from closure_closed[OF this] prems(1)
    have "x  R" "c  x  n" by auto
    with assms show ?thesis by auto
  qed
  subgoal for x
    using closure_subset by fastforce
  subgoal premises prems for x
  proof -
    note prems
    have *: "{xa  R. x  n  xa  n} = R"
      using assms prems by auto
    have "interior R  interior (plane n c)"
      by (rule interior_mono) (use assms in auto)
    also have " = {}"
      by (subst inner_commute) simp
    finally have R: "interior R = {}" by simp
    have "x  closure (- R)"
      unfolding closure_complement
      by (auto simp: R)
    then show ?thesis
      unfolding * by simp
  qed
  done

lemma blinfun_minus_comp_distrib: "(a - b) oL c = (a oL c) - (b oL c)"
  by (auto intro!: blinfun_eqI simp: blinfun.bilinear_simps)


lemma flowpipe_split_at_above_halfspace:
  assumes "flowpipe X0 hl t CX Y" "fst ` X0  {x. x  n  c} = {}" and [simp]: "n  0"
  assumes cR: "closed R" and Rs: "R  plane n c"
  assumes PDP: "x d. (x, d)  CX  x  n = c  (x,
     d - (blinfun_scaleR_left (f (x)) oL (blinfun_scaleR_left (inverse (f x  n)) oL (blinfun_inner_left n oL d))))  PDP"
  assumes PDP_nz: "x d. (x, d)  PDP  f x  n  0"
  assumes PDP_inR: "x d. (x, d)  PDP  x  R"
  assumes PDP_in: "x d. (x, d)  PDP  F x in at x within plane n c. x  R"
  obtains X1 X2 where "X0 = X1  X2"
    "flowsto X1 {0<..t} (CX  {x. x  n < c} × UNIV) (CX  {x  R. x  n = c} × UNIV)"
    "flowsto X2 {hl .. t} (CX  {x. x  n < c} × UNIV) (Y  ({x. x  n < c} × UNIV))"
    "poincare_mapsto {x  R. x  n = c} X1 UNIV (fst ` CX  {x. x  n < c}) PDP"
proof -
  let ?sB = "{x. x  n < c}"
  let ?A = "{x. x  n  c}"
  let ?P = "{x  R. x  n = c}"
  have [intro]: "closed ?A" "closed ?P"
    by (auto intro!: closed_Collect_le_within closed_levelset_within continuous_intros cR
        closed_halfspace_component_ge)
  let ?CX = "CX  ?sB × UNIV"
  let ?X1 = "{xX0. flowsto {x} {0 <.. t} ?CX (CX  (?P × UNIV))}"
  let ?X2 = "{xX0. flowsto {x} {hl .. t} ?CX (Y  (?sB × UNIV))}"
  have "(x, d)  ?X1  (x, d)  ?X2" if "(x, d)  X0" for x d
  proof -
    from that assms have
      t: "t  existence_ivl0 x" "s. 0  s  s  t  (flow0 x s, Dflow x s oL d)  CX" "(flow0 x t, Dflow x t oL d)  Y"
        apply (auto simp: flowpipe_def dest!: bspec[where x=t])
      apply (drule bspec[where x="(x, d)"], assumption)
      apply simp
      apply (drule bspec[where x=t], force)
      apply auto
      done
    show ?thesis
    proof (cases "s{0..t}. flow0 x s  ?sB")
      case True
      then have "(x, d)  ?X2" using assms t (x, d)  X0
        by (auto simp: flowpipe_def flowsto_def open_segment_eq_real_ivl dest!: bspec[where x="(x, d)"])
      then show ?thesis ..
    next
      case False
      then obtain s where s: "0  s" "s  t" "flow0 x s  ?A"
        by (auto simp: not_less)
      let ?I = "flow0 x -` ?A  {0 .. s}"
      from s have exivlI: "0  s'  s'  s  s'  existence_ivl0 x" for s'
        using ivl_subset_existence_ivl[OF t  existence_ivl0 x]
        by auto
      then have "compact ?I"
        unfolding compact_eq_bounded_closed
        by (intro conjI bounded_Int bounded_closed_interval disjI2 closed_vimage_Int)
          (auto intro!: continuous_intros closed_Collect_le_within cR)
      moreover
      from s have "?I  {}" by auto
      ultimately have "s?I. t?I. s  t"
        by (rule compact_attains_inf)
      then obtain s' where s': "s''. 0  s''  s'' < s'  flow0 x s''  ?A"
          "flow0 x s'  ?A" "0  s'" "s'  s"
        by (force simp: Ball_def)
      have "flow0 x 0 = x" using local.mem_existence_ivl_iv_defined(2) t(1) by auto
      also have "  ?A" using assms (x, d)  X0 by auto
      finally have "s'  0" using s' by auto
      then have "0 < s'" using s'  0 by simp
      have False if "flow0 x s'  interior ?A"
      proof -
        from that obtain e where "e > 0" and subset: "ball (flow0 x s') e  ?A"
          by (auto simp: mem_interior)
        from subset have "F s'' in at_left s'. ball (flow0 x s') e  ?A" by simp
        moreover
        from flow_continuous[OF exivlI[OF 0  s' s'  s]]
        have "flow0 x s' flow0 x s'" unfolding isCont_def .
        from tendstoD[OF this 0 < e]
        have "F xa in at_left s'. dist (flow0 x xa) (flow0 x s') < e"
          using eventually_at_split by blast
        then have "F s'' in at_left s'. flow0 x s''  ball (flow0 x s') e"
          by (simp add: dist_commute)
        moreover
        have "F s'' in at_left s'. 0 < s''"
          using 0 < s'
          using eventually_at_left by blast
        moreover
        have "F s'' in at_left s'. s'' < s'"
          by (auto simp: eventually_at_filter)
        ultimately
        have "F s'' in at_left s'. False"
          by eventually_elim (use s' in auto)
        then show False
          by auto
      qed
      then have "flow0 x s'  frontier ?A"
        unfolding frontier_def
        using ‹closed ?A s'
        by auto
      with s' have "(x, d)  ?X1" using assms that s t 0 < s'
        ivl_subset_existence_ivl[OF t  existence_ivl0 x]
        frontier_subset_closed[OF ‹closed ?A]
        apply (auto simp: flowsto_def flowpipe_def open_segment_eq_real_ivl frontier_halfspace_component_ge
            intro!:
            dest!: bspec[where x="(x, d)"]
            intro: exivlI)
        apply (safe intro!: bexI[where x=s'])
        subgoal by force
        subgoal premises prems
        proof -
          have CX: "(flow0 x s', Dflow x s' oL d)  CX"
            using prems
            by (auto intro!: prems)
          have "flow0 x s'  n = c" using prems by auto
          from PDP_inR[OF PDP[OF CX this]]
          show "flow0 x s'  R" .
        qed
        subgoal by (auto simp: not_le)
        subgoal by force
        done
      then show ?thesis ..
    qed
  qed
  then have "X0 = ?X1  ?X2" by auto
  moreover
  have X1: "flowsto ?X1 {0 <.. t} ?CX (CX  (?P × UNIV))"
    and X2: "flowsto ?X2 {hl .. t} ?CX (Y  (?sB × UNIV))"
    by (auto simp: flowsto_def flowpipe_def)
  moreover
  from assms(2) X1 have "poincare_mapsto ?P ?X1 UNIV (fst ` CX  {x. x  n < c}) PDP"
    unfolding poincare_mapsto_def flowsto_def
    apply clarsimp
    subgoal premises prems for x d t
    proof -
      note prems
      have ret: "returns_to ?P x"
        apply (rule returns_to_outsideI[where t=t])
        using prems ‹closed ?P
        by auto
      moreover
      have ret_le: "return_time ?P x  t"
        apply (rule return_time_le[OF ret _ _ 0 < t])
        using prems ‹closed ?P by auto
      from prems have CX: "(flow0 x h', (Dflow x h') oL d)  CX" if "0 < h'" "h'  t" for h'
        using that by (auto simp: open_segment_eq_real_ivl)
      have PDP: "(poincare_map ?P x, Dpoincare_map' n c R x oL d)  PDP"
        unfolding poincare_map_def Dpoincare_map'_def
        unfolding blinfun_compose_assoc blinfun_minus_comp_distrib
        apply (rule PDP)
        using poincare_map_returns[OF ret ‹closed ?P] ret_le
        by (auto simp: poincare_map_def intro!: CX return_time_pos ret)
      have "eventually (returns_to ({x  R. x  n - c = 0})) (at x)"
        apply (rule eventually_returns_to)
        using PDP_nz[OF PDP] assms(2) (x, d)  X0 cR PDP_in[OF PDP]
        by (auto intro!: ret derivative_eq_intros blinfun_inner_left.rep_eq[symmetric]
            simp: eventually_at_filter)
      moreover have "return_time ?P differentiable at x"
        apply (rule differentiableI)
        apply (rule return_time_plane_has_derivative)
        using prems ret PDP_nz[OF PDP] PDP cR PDP_in[OF PDP]
        by (auto simp: eventually_at_filter)
      moreover
      have "(D. (poincare_map ?P has_derivative blinfun_apply D) (at x)  (poincare_map ?P x, D oL d)  PDP)"
        apply (intro exI[where x="Dpoincare_map' n c R x"])
        using prems ret PDP_nz[OF PDP] PDP cR PDP_in[OF PDP]
        by (auto simp: eventually_at_filter intro!: poincare_map_plane_has_derivative)
      moreover have
        "flow0 x h  fst ` CX  (c > flow0 x h  n)"
        if "0 < h" "h < return_time ?P x" for h
        using CX[of h] ret that ret_le 0 < h
        apply (auto simp: open_segment_eq_real_ivl intro!: image_eqI[where x="(flow0 x h, (Dflow x h) oL d)"])
        using prems
        by (auto simp add: open_segment_eq_real_ivl dest!: bspec[where x=t])
      ultimately show ?thesis
        unfolding prems(7)[symmetric]
        by force
    qed
    done
  ultimately show ?thesis ..
qed

lemma poincare_map_has_derivative_step:
  assumes Deriv: "(poincare_map P has_derivative blinfun_apply D) (at (flow0 x0 h))"
  assumes ret: "returns_to P x0"
  assumes cont: "continuous (at x0 within S) (return_time P)"
  assumes less: "0  h" "h < return_time P x0"
  assumes cP: "closed P" and x0: "x0  S"
  shows "((λx. poincare_map P x) has_derivative (D oL Dflow x0 h)) (at x0 within S)"
proof (rule has_derivative_transform_eventually)
  note return_time_tendsto = cont[unfolded continuous_within, rule_format]
  have "return_time P x0  existence_ivl0 x0"
    by (auto intro!: return_time_exivl cP ret)
  from ivl_subset_existence_ivl[OF this] less
  have hex: "h  existence_ivl0 x0" by auto
  from eventually_mem_existence_ivl[OF this]
  have "F x in at x0 within S. h  existence_ivl0 x"
    by (auto simp: eventually_at)
  moreover
  have "F x in at x0 within S. h < return_time P x"
    apply (rule order_tendstoD)
     apply (rule return_time_tendsto)
    by (auto intro!: x0 less)
  moreover have evret: "eventually (returns_to P) (at x0 within S)"
    by (rule eventually_returns_to_continuousI; fact)
  ultimately
  show "F x in at x0 within S. poincare_map P (flow0 x h) = poincare_map P x"
    apply eventually_elim
    apply (cases "h = 0")
    subgoal by auto
    subgoal for x
      apply (rule poincare_map_step_flow)
      using 0  h return_time_least[of P x ]
      by (auto simp: ‹closed P)
    done
  show "poincare_map P (flow0 x0 h) = poincare_map P x0"
    using less ret x0 cP hex
    apply (cases "h = 0")
    subgoal by auto
    subgoal
      apply (rule poincare_map_step_flow)
      using 0  h return_time_least[of P x0] ret
      by (auto simp: ‹closed P)
    done
  show "x0  S" by fact
  show "((λx. poincare_map P (flow0 x h)) has_derivative blinfun_apply (D oL Dflow x0 h)) (at x0 within S)"
    apply (rule has_derivative_compose[where g="poincare_map P" and f="λx. flow0 x h", OF _ Deriv,
        THEN has_derivative_eq_rhs])
    by (auto intro!: derivative_eq_intros simp: hex flowderiv_def)
qed

lemma poincare_mapsto_trans:
  assumes "poincare_mapsto p1 X0 S    CX P1"
  assumes "poincare_mapsto p2 P1 UNIV CY P2"
  assumes "CX  CY  fst ` P1  CZ"
  assumes "p2  (CX  fst ` P1) = {}"
  assumes [intro, simp]: "closed p1"
  assumes [intro, simp]: "closed p2"
  assumes cont: "x d. (x, d)  X0  continuous (at x within S) (return_time p2)"
  shows "poincare_mapsto p2 X0 S CZ P2"
  unfolding poincare_mapsto_def
proof (auto, goal_cases)
  fix x0 d0 assume x0: "(x0, d0)  X0"
  from assms(1) x0 obtain D1 dR1 where 1:
    "returns_to p1 x0"
    "fst ` X0  S"
    "(return_time p1 has_derivative dR1) (at x0 within S)"
    "(poincare_map p1 has_derivative blinfun_apply D1) (at x0 within S)"
    "(poincare_map p1 x0, D1 oL d0)  P1"
    "t. 0 < t  t < return_time p1 x0  flow0 x0 t  CX"
    by (auto simp: poincare_mapsto_def differentiable_def)
  then have crt1: "continuous (at x0 within S) (return_time p1)"
    by (auto intro!: has_derivative_continuous)
  show "x0  S"
    using 1 x0 by auto
  let ?x0 = "poincare_map p1 x0"
  from assms(2) x0 _  P1
  obtain D2 dR2 where 2:
    "returns_to p2 ?x0"
    "(return_time p2 has_derivative dR2) (at ?x0)"
    "(poincare_map p2 has_derivative blinfun_apply D2) (at ?x0)"
    "(poincare_map p2 ?x0, D2 oL (D1 oL d0))  P2"
    "t. t{0<..<return_time p2 ?x0}  flow0 ?x0 t  CY"
    by (auto simp: poincare_mapsto_def differentiable_def)

  have "F t in at_right 0. t < return_time p1 x0"
    by (rule order_tendstoD) (auto intro!: return_time_pos 1)
  moreover have "F t in at_right 0. 0 < t"
    by (auto simp: eventually_at_filter)
  ultimately have evnotp2: "F t in at_right 0. flow0 x0 t  p2"
    by eventually_elim (use assms 1 in auto)
  from 2(1)
  show ret2: "returns_to p2 x0"
    unfolding poincare_map_def
    by (rule returns_to_earlierI)
       (use evnotp2 in auto intro!: less_imp_le return_time_pos 1 return_time_exivl›)
  have not_p2: "0 < t  t  return_time p1 x0  flow0 x0 t  p2" for t
    using 1(5) 1(6)[of t] assms(4)
    by (force simp: poincare_map_def set_eq_iff)
  have pm_eq: "poincare_map p2 x0 = poincare_map p2 (poincare_map p1 x0)"
    using not_p2
    apply (auto simp: poincare_map_def)
    apply (subst flow_trans[symmetric])
      apply (auto intro!: return_time_exivl 1 2[unfolded poincare_map_def])
    apply (subst return_time_step)
    by (auto simp: return_time_step
        intro!: return_time_exivl 1 2[unfolded poincare_map_def] return_time_pos)

  have evret2: "F x in at ?x0. returns_to p2 x"
    by (auto intro!: eventually_returns_to_continuousI 2 has_derivative_continuous)

  have evret1: "F x in at x0 within S. returns_to p1 x"
    by (auto intro!: eventually_returns_to_continuousI 1 has_derivative_continuous)
  moreover
  from evret2[unfolded eventually_at_topological] 2(1)
  obtain U where U: "open U" "poincare_map p1 x0  U" "x. x  U  returns_to p2 x"
    by force
  have "continuous (at x0 within S) (poincare_map p1)"
    by (rule has_derivative_continuous) (rule 1)
  note [tendsto_intros] = this[unfolded continuous_within]
  have "eventually (λx. poincare_map p1 x  U) (at x0 within S)"
    by (rule topological_tendstoD) (auto intro!: tendsto_eq_intros U)
  then have evret_flow: "F x in at x0 within S. returns_to p2 (flow0 x (return_time p1 x))"
    unfolding poincare_map_def[symmetric]
    apply eventually_elim
    apply (rule U)
    apply auto
    done
  moreover
  have h_less_rt: "return_time p1 x0 < return_time p2 x0"
    by (rule return_time_gt; fact)
  then have "0 < return_time p2 x0 - return_time p1 x0"
    by (simp )
  from _ this have "F x in at x0 within S. 0 < return_time p2 x - return_time p1 x"
    apply (rule order_tendstoD)
    using cont (x0, _)  _
    by (auto intro!: tendsto_eq_intros crt1 simp: continuous_within[symmetric] continuous_on_def)
  then have evpm2: "F x in at x0 within S. s. 0 < s  s  return_time p1 x  flow0 x s  p2"
    apply eventually_elim
    apply safe
    subgoal for x s
      using return_time_least[of p2 x s]
      by (auto simp add: return_time_pos_returns_to)
    done
  ultimately
  have pm_eq_at: "F x in at x0 within S.
    poincare_map p2 (poincare_map p1 x) = poincare_map p2 x"
    apply (eventually_elim)
    apply (auto simp: poincare_map_def)
    apply (subst flow_trans[symmetric])
      apply (auto intro!: return_time_exivl)
    apply (subst return_time_step)
    by (auto simp: return_time_step
        intro!: return_time_exivl return_time_pos)
  from _ this have "(poincare_map p2 has_derivative blinfun_apply (D2 oL D1)) (at x0 within S)"
    apply (rule has_derivative_transform_eventually)
      apply (rule has_derivative_compose[OF 1(4) 2(3), THEN has_derivative_eq_rhs])
    by (auto simp: x0  S pm_eq)
  moreover have "(poincare_map p2 x0, (D2 oL D1) oL d0)  P2"
    using 2(4) unfolding pm_eq blinfun_compose_assoc .
  ultimately
  show "D. (poincare_map p2 has_derivative blinfun_apply D) (at x0 within S) 
               (poincare_map p2 x0, D oL d0)  P2"
    by auto
  show "0 < t  t < return_time p2 x0  flow0 x0 t  CZ" for t
    apply (cases "t < return_time p1 x0")
    subgoal
      apply (drule 1)
      using assms
      by auto
    subgoal
      apply (cases "t = return_time p1 x0")
      subgoal using 1(5) assms by (auto simp: poincare_map_def)
      subgoal premises prems
      proof -
        have "flow0 x0 t = flow0 ?x0 (t - return_time p1 x0)"
          unfolding poincare_map_def
          apply (subst flow_trans[symmetric])
          using prems
          by (auto simp:
              intro!: return_time_exivl 1 diff_existence_ivl_trans
              less_return_time_imp_exivl[OF _ ret2])
        also have "  CY"
          apply (rule 2)
          using prems
          apply auto
          using "1"(1) "2"(1) assms poincare_map_def ret2 return_time_exivl
            return_time_least return_time_pos return_time_step
          by auto
        also have "  CZ" using assms by auto
        finally show "flow0 x0 t  CZ"
          by simp
      qed
      done
    done
  have rt_eq: "return_time p2 (poincare_map p1 x0) + return_time p1 x0 = return_time p2 x0"
    apply (auto simp: poincare_map_def)
    apply (subst return_time_step)
    by (auto simp: return_time_step poincare_map_def[symmetric] not_p2
        intro!: return_time_exivl return_time_pos 1 2)
  have evrt_eq: "F x in at x0 within S.
    return_time p2 (poincare_map p1 x) + return_time p1 x = return_time p2 x"
    using evret_flow evret1 evpm2
    apply (eventually_elim)
    apply (auto simp: poincare_map_def)
    apply (subst return_time_step)
    by (auto simp: return_time_step
        intro!: return_time_exivl return_time_pos)
  from _ evrt_eq
  have "(return_time p2 has_derivative (λx. dR2 (blinfun_apply D1 x) + dR1 x)) (at x0 within S)"
    by (rule has_derivative_transform_eventually)
      (auto intro!: derivative_eq_intros has_derivative_compose[OF 1(4) 2(2)] 1(3) x0  S
        simp: rt_eq)
  then show "return_time p2 differentiable at x0 within S" by (auto intro!: differentiableI)
qed

lemma flowsto_poincare_trans:― ‹TODO: the proof is close to @{thm poincare_mapsto_trans}
  assumes f: "flowsto            X0 T     CX P1"
  assumes "poincare_mapsto p2 P1 UNIV CY P2"
  assumes nn: "t. t  T  t  0"
  assumes "fst ` CX  CY  fst ` P1  CZ"
  assumes "p2  (fst ` CX  fst ` P1) = {}"
  assumes [intro, simp]: "closed p2"
  assumes cont: "x d. (x, d)  X0  continuous (at x within S) (return_time p2)"
  assumes subset: "fst ` X0  S"
  shows "poincare_mapsto p2 X0 S CZ P2"
  unfolding poincare_mapsto_def
proof (auto, goal_cases)
  fix x0 d0 assume x0: "(x0, d0)  X0"
  from flowstoE[OF f x0] obtain h where 1:
    "h  T" "h  existence_ivl0 x0"
    "(flow0 x0 h, Dflow x0 h oL d0)  P1" (is "(?x0, _)  _")
    "(h'. h'  {0<--<h}  (flow0 x0 h', Dflow x0 h' oL d0)  CX)"
    by auto
  then have CX: "(h'. 0 < h'  h' < h  (flow0 x0 h', Dflow x0 h' oL d0)  CX)"
    by (auto simp: nn open_segment_eq_real_ivl)
  from 1 have "0  h" by (auto simp: nn)
  from assms have CX_p2D: "x  CX  fst x  p2" for x by auto
  from assms have P1_p2D: "x  P1  fst x  p2" for x by auto
  show "x0  S"
    using x0 1 subset by auto
  let ?D1 = "Dflow x0 h"
  from assms(2) x0 _  P1
  obtain D2 dR2 where 2:
    "returns_to p2 ?x0"
    "(return_time p2 has_derivative dR2) (at ?x0)"
    "(poincare_map p2 has_derivative blinfun_apply D2) (at ?x0)"
    "(poincare_map p2 ?x0, D2 oL (?D1 oL d0))  P2"
    "t. t{0<..<return_time p2 ?x0}  flow0 ?x0 t  CY"
    by (auto simp: poincare_mapsto_def differentiable_def)

  {
    assume pos: "h > 0"
    have "F t in at_right 0. t < h"
      by (rule order_tendstoD) (auto intro!: return_time_pos 1 pos)
    moreover have "F t in at_right 0. 0 < t"
      by (auto simp: eventually_at_filter)
    ultimately have "F t in at_right 0. flow0 x0 t  p2"
      by eventually_elim (use assms in force dest: CX CX_p2D›)
  } note evnotp2 = this
  from 2(1)
  show ret2: "returns_to p2 x0"
    apply (cases "h = 0")
    subgoal using 1 by auto
    unfolding poincare_map_def
    by (rule returns_to_earlierI)
       (use evnotp2 0  h in auto intro!: less_imp_le return_time_pos 1 return_time_exivl ›)
  have not_p2: "0 < t  t  h  flow0 x0 t  p2" for t
    using 1(1-3) CX[of t] assms(4) CX_p2D P1_p2D
    by (cases "h = t") (auto simp: poincare_map_def set_eq_iff subset_iff)
  have pm_eq: "poincare_map p2 x0 = poincare_map p2 ?x0"
    apply (cases "h = 0", use 1 in force)
    using not_p2 0  h
    apply (auto simp: poincare_map_def)
    apply (subst flow_trans[symmetric])
      apply (auto intro!: return_time_exivl 1 2[unfolded poincare_map_def])
    apply (subst return_time_step)
    by (auto simp: return_time_step 
        intro!: return_time_exivl 1 2[unfolded poincare_map_def] return_time_pos)

  have evret2: "F x in at ?x0. returns_to p2 x"
    by (auto intro!: eventually_returns_to_continuousI 2 has_derivative_continuous)

  have "F x in at x0. h  existence_ivl0 x"
    by (simp add: 1 eventually_mem_existence_ivl)
  then have evex: "F x in at x0 within S. h  existence_ivl0 x"
    by (auto simp: eventually_at)
  moreover
  from evret2[unfolded eventually_at_topological] 2(1)
  obtain U where U: "open U" "flow0 x0 h  U" "x. x  U  returns_to p2 x"
    by force
  note [tendsto_intros] = this[unfolded continuous_within]
  have "eventually (λx. flow0 x h  U) (at x0 within S)"
    by (rule topological_tendstoD) (auto intro!: tendsto_eq_intros U 1)
  then have evret_flow: "F x in at x0 within S. returns_to p2 (flow0 x h)"
    unfolding poincare_map_def[symmetric]
    apply eventually_elim
    apply (rule U)
    apply auto
    done
  moreover
  have h_less_rt: "h < return_time p2 x0"
    by (rule return_time_gt; fact)
  then have "0 < return_time p2 x0 - h"
    by (simp )
  from _ this have "F x in at x0 within S. 0 < return_time p2 x - h"
    apply (rule order_tendstoD)
    using cont (x0, _)  _
    by (auto intro!: tendsto_eq_intros simp: continuous_within[symmetric] continuous_on_def)
  then have evpm2: "F x in at x0 within S. s. 0 < s  s  h  flow0 x s  p2"
    apply eventually_elim
    apply safe
    subgoal for x s
      using return_time_least[of p2 x s]
      by (auto simp add: return_time_pos_returns_to)
    done
  ultimately
  have pm_eq_at: "F x in at x0 within S.
    poincare_map p2 (flow0 x h) = poincare_map p2 x"
    apply (eventually_elim)
    apply (cases "h = 0") subgoal by auto
    apply (auto simp: poincare_map_def)
    apply (subst flow_trans[symmetric])
      apply (auto intro!: return_time_exivl)
    apply (subst return_time_step)
    using 0  h
    by (auto simp: return_time_step intro!: return_time_exivl return_time_pos)
  from _ this have "(poincare_map p2 has_derivative blinfun_apply (D2 oL ?D1)) (at x0 within S)"
    apply (rule has_derivative_transform_eventually)
    apply (rule has_derivative_at_withinI)
    apply (rule has_derivative_compose[OF flow_has_space_derivative 2(3), THEN has_derivative_eq_rhs])
    by (auto simp: x0  S pm_eq 1)
  moreover have "(poincare_map p2 x0, (D2 oL ?D1) oL d0)  P2"
    using 2(4) unfolding pm_eq blinfun_compose_assoc .
  ultimately
  show "D. (poincare_map p2 has_derivative blinfun_apply D) (at x0 within S) 
               (poincare_map p2 x0, D oL d0)  P2"
    by auto
  show "0 < t  t < return_time p2 x0  flow0 x0 t  CZ" for t
    apply (cases "t < h")
    subgoal
      apply (drule CX)
      using assms
      by auto
    subgoal
      apply (cases "t = h")
      subgoal using 1 assms by (auto simp: poincare_map_def)
      subgoal premises prems
      proof -
        have "flow0 x0 t = flow0 ?x0 (t - h)"
          unfolding poincare_map_def
          apply (subst flow_trans[symmetric])
          using prems
          by (auto simp:
              intro!: return_time_exivl 1 diff_existence_ivl_trans
              less_return_time_imp_exivl[OF _ ret2])
        also have "  CY"
          apply (cases "h = 0")
          subgoal using "1"(2) "2"(5) prems(1) prems(2) by auto
          subgoal
            apply (rule 2)
            using prems
            apply auto
            apply (subst return_time_step)
                 apply (rule returns_to_laterI)
            using ret2 0  h h  existence_ivl0 x0 not_p2
            by auto
          done
          also have "  CZ" using assms by auto
        finally show "flow0 x0 t  CZ"
          by simp
      qed
      done
    done
  have rt_eq: "return_time p2 ?x0 + h = return_time p2 x0"
    apply (cases "h = 0")
    subgoal using 1 by auto
    subgoal
      apply (subst return_time_step)
      using 0  h
      by (auto simp: return_time_step poincare_map_def[symmetric] not_p2
          intro!: return_time_exivl return_time_pos 1 2)
    done
  have evrt_eq: "F x in at x0 within S.
    return_time p2 (flow0 x h) + h = return_time p2 x"
    using evret_flow evpm2 evex
    apply (eventually_elim)
    apply (cases "h = 0")
    subgoal using 1 by auto
    subgoal
      apply (subst return_time_step)
      using 0  h
      by (auto simp: return_time_step
          intro!: return_time_exivl return_time_pos)
    done
  from _ evrt_eq
  have "(return_time p2 has_derivative (λx. dR2 (blinfun_apply ?D1 x))) (at x0 within S)"
    apply (rule has_derivative_transform_eventually)
      apply (rule has_derivative_at_withinI)
    by (auto intro!: derivative_eq_intros has_derivative_compose[OF flow_has_space_derivative 2(2)] 1 x0  S
        simp: rt_eq)
  then show "return_time p2 differentiable at x0 within S" by (auto intro!: differentiableI)
qed



subsection ‹conditions for continuous return time›


definition "section s Ds S 
  (x. (s has_derivative blinfun_apply (Ds x)) (at x)) 
  (x. isCont Ds x) 
  (x  S. s x = (0::real)  Ds x (f x)  0) 
  closed S  S  X"

lemma sectionD:
  assumes "section s Ds S"
  shows "(s has_derivative blinfun_apply (Ds x)) (at x)"
    "isCont Ds x"
    "x  S  s x = 0  Ds x (f x)  0"
    "closed S" "S  X"
  using assms by (auto simp: section_def)

definition "transversal p  (x  p. F t in at_right 0. flow0 x t  p)"

lemma transversalD: "transversal p  x  p  F t in at_right 0. flow0 x t  p"
  by (auto simp: transversal_def)

lemma transversal_section:
  fixes c::real
  assumes "section s Ds S"
  shows "transversal {x  S. s x = 0}"
  using assms
  unfolding section_def transversal_def
proof (safe, goal_cases)
  case (1 x)
  then have "x  X" by auto
  have "F t in at_right 0. flow0 x t  {xa  S. s xa = 0}"
    by (rule flow_avoids_surface_eventually_at_right)
      (rule disjI2 assms 1[rule_format] refl x  X)+
  then show ?case
    by simp
qed

lemma section_closed[intro, simp]: "section s Ds S  closed {x  S. s x = 0}"
  by (auto intro!: closed_levelset_within simp: section_def
      intro!: has_derivative_continuous_on has_derivative_at_withinI[where s=S])


lemma return_time_continuous_belowI:
  assumes ft: "flowsto X0 T CX X1"
  assumes pos: "t. t  T  t > 0"
  assumes X0: "fst ` X0  {x  S. s x = 0}"
  assumes CX: "fst ` CX  {x  S. s x = 0} = {}"
  assumes X1: "fst ` X1  {x  S. s x = 0}"
  assumes sec: "section s Ds S"
  assumes nz: "x. x  S  s x = 0  Ds x (f x)  0"
  assumes Dneg: "(λx. (Ds x) (f x)) ` fst ` X0  {..<0}"
  assumes rel_int: "x. x  fst ` X1  F x in at x. s x = 0  x  S"
  assumes "(x, d)  X0"
  shows "continuous (at x within {x. s x  0}) (return_time {x  S. s x = 0})"
proof (rule return_time_continuous_below)
  from assms have "x  S" "s x = 0" "x  {x  S. s x = 0}" by auto
  note cs = section_closed[OF sec]
  note sectionD[OF sec]
  from flowstoE[OF ft (x, d)  X0] obtain h
    where h: "h  T"
      "h  existence_ivl0 x"
      "(flow0 x h, Dflow x h oL d)  X1"
      "(h'. h'  {0<--<h}  (flow0 x h', Dflow x h' oL d)  CX)"
    by blast
  show ret: "returns_to {x  S. s x = 0} x"
    apply (rule returns_toI)
        apply (rule pos)
        apply (rule h)
    subgoal by (rule h)
    subgoal using h(3) X1 by auto
    subgoal apply (intro transversalD) apply (rule transversal_section) apply (rule sec)
      apply fact
      done
    subgoal by fact
    done
  show "(s has_derivative blinfun_apply (Ds x)) (at x)" for x by fact
  show "closed S" by fact
  show "isCont Ds x" for x by fact
  show "x  S" "s x = 0" by fact+
  let ?p = "poincare_map {x  S. s x = 0} x"
  have "?p  {x  S. s x = 0}" using poincare_map_returns[OF ret cs] .
  with nz show "Ds ?p (f ?p)  0" by auto
  from Dneg (x, _)  X0 show "Ds x (f x) < 0" by force
  from _  X1 X1 CX h
  have "return_time {x  S. s x = 0} x = h"
    by (fastforce intro!: return_time_eqI cs pos h simp: open_segment_eq_real_ivl)
  then have "?p  fst ` X1"
    using _  X1 by (force simp: poincare_map_def)
  from rel_int[OF this] show " F x in at (poincare_map {x  S. s x = 0} x). s x = 0  x  S"
    by auto
qed

end

end

Theory Flow_Congs

theory Flow_Congs
  imports Reachability_Analysis
begin

lemma lipschitz_on_congI:
  assumes "L'-lipschitz_on s' g'"
  assumes "s' = s"
  assumes "L'  L"
  assumes "x y. x  s  g' x = g x"
  shows "L-lipschitz_on s g"
  using assms
  by (auto simp: lipschitz_on_def intro!: order_trans[OF _ mult_right_mono[OF L'  L]])

lemma local_lipschitz_congI:
  assumes "local_lipschitz s' t' g'"
  assumes "s' = s"
  assumes "t' = t"
  assumes "x y. x  s  y  t  g' x y = g x y"
  shows "local_lipschitz s t g"
proof -
  from assms have "local_lipschitz s t g'"
    by (auto simp: local_lipschitz_def)
  then show ?thesis
    apply (auto simp: local_lipschitz_def)
    apply (drule_tac bspec, assumption)
    apply (drule_tac bspec, assumption)
    apply auto
    subgoal for x y u L
    apply (rule exI[where x=u])
      apply (auto intro!: exI[where x=L])
      apply (drule bspec)
      apply simp
      apply (rule lipschitz_on_congI, assumption, rule refl, rule order_refl)
      using assms
      apply (auto)
      done
    done
qed

context ll_on_open_it― ‹TODO: do this more generically for @{const ll_on_open_it}
begin

context fixes S Y g assumes cong: "X = Y" "T = S" "x t. x  Y  t  S  f t x = g t x"
begin

lemma ll_on_open_congI: "ll_on_open S g Y"
proof -
  interpret Y: ll_on_open_it S f Y t0
    apply (subst cong(1)[symmetric])
    apply (subst cong(2)[symmetric])
    by unfold_locales
  show ?thesis
    apply standard
    subgoal
      using local_lipschitz
      apply (rule local_lipschitz_congI)
      using cong by simp_all
    subgoal apply (subst continuous_on_cong) prefer 3 apply (rule cont)
      using cong by (auto)
    subgoal using open_domain by (auto simp: cong)
    subgoal using open_domain by (auto simp: cong)
    done
qed

lemma existence_ivl_subsetI:
  assumes t: "t  existence_ivl t0 x0"
  shows "t  ll_on_open.existence_ivl S g Y t0 x0"
proof -
  from assms have t0  T "x0  X"
    by (rule mem_existence_ivl_iv_defined)+
  interpret Y: ll_on_open S g Y by (rule ll_on_open_congI)
  have "(flow t0 x0 solves_ode f) (existence_ivl t0 x0) X"
    by (rule flow_solves_ode) (auto simp: x0  X t0  T)
  then have "(flow t0 x0 solves_ode f) {t0--t} X"
    by (rule solves_ode_on_subset)
     (auto simp add: t local.closed_segment_subset_existence_ivl)
  then have "(flow t0 x0 solves_ode g) {t0--t} Y"
    apply (rule solves_ode_congI)
       apply (auto intro!: assms cong)
    using (flow t0 x0 solves_ode f) {t0--t} X local.cong(1) solves_ode_domainD apply blast
    using t0  T assms closed_segment_subset_domainI general.mem_existence_ivl_subset local.cong(2)
    by blast
  then show ?thesis
    apply (rule Y.existence_ivl_maximal_segment)
    subgoal by (simp add: t0  T x0  X)
    apply (subst cong[symmetric])
    using t0  T assms closed_segment_subset_domainI general.mem_existence_ivl_subset local.cong(2)
    by blast
qed

lemma existence_ivl_cong:
  shows "existence_ivl t0 x0 = ll_on_open.existence_ivl S g Y t0 x0"
proof -
  interpret Y: ll_on_open S g Y by (rule ll_on_open_congI)
  show ?thesis
    apply (auto )
    subgoal by (rule existence_ivl_subsetI)
    subgoal
      apply (rule Y.existence_ivl_subsetI)
      using cong
      by auto
    done
qed

lemma flow_cong:
  assumes "t  existence_ivl t0 x0"
  shows "flow t0 x0 t = ll_on_open.flow S g Y t0 x0 t"
proof -
  interpret Y: ll_on_open S g Y by (rule ll_on_open_congI)
  from assms have "t0  T" "x0  X"
    by (rule mem_existence_ivl_iv_defined)+
  from cong x0  X have "x0  Y" by auto
  from cong t0  T have "t0  S" by auto
  show ?thesis
    apply (rule Y.equals_flowI[where T'="existence_ivl t0 x0"])
    subgoal using t0  T x0  X  by auto
    subgoal using x0  X by auto
    subgoal by (auto simp: existence_ivl_cong x0  X)
    subgoal
      apply (rule solves_ode_congI)
          apply (rule flow_solves_ode[OF t0  T x0  X])
      using existence_ivl_subset[of x0]
      by (auto simp: cong(2)[symmetric] cong(1)[symmetric] assms flow_in_domain intro!: cong)
    subgoal using t0  S t0  T x0  X x0  Y
      by (auto simp:)
    subgoal by fact
    done
qed

end

end

context auto_ll_on_open begin

context fixes Y g assumes cong: "X = Y" "x t. x  Y  f x = g x"
begin

lemma auto_ll_on_open_congI: "auto_ll_on_open g Y"
  apply unfold_locales
  subgoal
    using local_lipschitz
    apply (rule local_lipschitz_congI)
    using cong by auto
  subgoal
    using open_domain
    using cong by auto
  done

lemma existence_ivl0_cong:
  shows "existence_ivl0 x0 = auto_ll_on_open.existence_ivl0 g Y x0"
proof -
  interpret Y: auto_ll_on_open g Y by (rule auto_ll_on_open_congI)
  show ?thesis
    unfolding Y.existence_ivl0_def
    apply (rule existence_ivl_cong)
    using cong by auto
qed

lemma flow0_cong:
  assumes "t  existence_ivl0 x0"
  shows "flow0 x0 t = auto_ll_on_open.flow0 g Y x0 t"
proof -
  interpret Y: auto_ll_on_open g Y by (rule auto_ll_on_open_congI)
  show ?thesis
    unfolding Y.flow0_def
    apply (rule flow_cong)
    using cong assms by auto
qed

end

end


context c1_on_open_euclidean begin

context fixes Y g assumes cong: "X = Y" "x t. x  Y  f x = g x"
begin

lemma f'_cong: "(g has_derivative blinfun_apply (f' x)) (at x)" if "x  Y"
proof -
  from derivative_rhs[of x] that cong
  have "(f has_derivative blinfun_apply (f' x)) (at x within Y)"
    by (auto intro!: has_derivative_at_withinI)
  then have "(g has_derivative blinfun_apply (f' x)) (at x within Y)"
    by (rule has_derivative_transform_within[OF _ zero_less_one that])
       (auto simp: cong)
  then show ?thesis
    using at_within_open[OF that] cong open_dom
    by (auto simp: )
qed

lemma c1_on_open_euclidean_congI: "c1_on_open_euclidean g f' Y"
proof -
  interpret Y: c1_on_open_euclidean f f' Y unfolding cong[symmetric] by unfold_locales
  show ?thesis
    apply standard
    subgoal using cong by simp
    subgoal by (rule f'_cong)
    subgoal by (simp add: cong[symmetric] continuous_derivative)
    done
qed

lemma vareq_cong: "vareq x0 t = c1_on_open_euclidean.vareq g f' Y x0 t"
  if "t  existence_ivl0 x0"
proof -
  interpret Y: c1_on_open_euclidean g f' Y by (rule c1_on_open_euclidean_congI)
  show ?thesis
    unfolding vareq_def Y.vareq_def
    apply (rule arg_cong[where f=f'])
    apply (rule flow0_cong)
    using cong that by auto
qed

lemma Dflow_cong:
  assumes "t  existence_ivl0 x0"
  shows "Dflow x0 t = c1_on_open_euclidean.Dflow g f' Y x0 t"
proof -
  interpret Y: c1_on_open_euclidean g f' Y by (rule c1_on_open_euclidean_congI)
  from assms have "x0  X"
    by (rule mem_existence_ivl_iv_defined)
  from cong x0  X have "x0  Y" by auto
  show ?thesis
    unfolding Dflow_def Y.Dflow_def
    apply (rule mvar.equals_flowI[symmetric, OF _ _ order_refl])
    subgoal using x0  X by auto
    subgoal using x0  X by auto
    subgoal
      apply (rule solves_ode_congI)
          apply (rule Y.mvar.flow_solves_ode)
           prefer 3 apply (rule refl)
      subgoal using x0  X x0  Y by auto
      subgoal using x0  X x0  Y by auto
      subgoal for t
        apply (subst vareq_cong)
         apply (subst (asm) Y.mvar_existence_ivl_eq_existence_ivl)
        subgoal using x0  Y by simp
        subgoal
          using cong
          by (subst (asm) existence_ivl0_cong[symmetric]) auto
        subgoal using x0  Y by simp
        done
      subgoal using x0  X x0  Y
        apply (subst mvar_existence_ivl_eq_existence_ivl)
        subgoal by simp
        apply (subst Y.mvar_existence_ivl_eq_existence_ivl)
        subgoal by simp
        using cong
        by (subst existence_ivl0_cong[symmetric]) auto
      subgoal by simp
      done
    subgoal using x0  X x0  Y by auto
    subgoal
      apply (subst mvar_existence_ivl_eq_existence_ivl)
       apply auto
       apply fact+
      done
    done
qed

lemma flowsto_congI1:
  assumes "flowsto A B C D"
  shows "c1_on_open_euclidean.flowsto g f' Y A B C D"
proof -
  interpret Y: c1_on_open_euclidean g f' Y by (rule c1_on_open_euclidean_congI)
  show ?thesis
    using assms
    unfolding flowsto_def Y.flowsto_def
    apply (auto simp: existence_ivl0_cong[OF cong]  flow0_cong[OF cong])
       apply (drule bspec, assumption)
    apply clarsimp
    apply (rule bexI)
    apply (rule conjI)
       apply assumption
     apply (subst flow0_cong[symmetric, OF cong])
     apply auto
      apply (subst existence_ivl0_cong[OF cong])
    apply auto
    apply (subst Dflow_cong[symmetric])
     apply auto
      apply (subst existence_ivl0_cong[OF cong])
    apply auto
    apply (drule bspec, assumption)
    apply (subst flow0_cong[symmetric, OF cong])
     apply auto
      apply (subst existence_ivl0_cong[OF cong])
    apply auto defer
    apply (subst Dflow_cong[symmetric])
     apply auto
     apply (subst existence_ivl0_cong[OF cong])
    apply auto
     apply (drule Y.closed_segment_subset_existence_ivl;
        auto simp: open_segment_eq_real_ivl closed_segment_eq_real_ivl split: if_splits)+
    done
qed

lemma flowsto_congI2:
  assumes "c1_on_open_euclidean.flowsto g f' Y A B C D"
  shows "flowsto A B C D"
proof -
  interpret Y: c1_on_open_euclidean g f' Y by (rule c1_on_open_euclidean_congI)
  show ?thesis
    apply (rule Y.flowsto_congI1)
    using assms
    by (auto simp: cong)
qed

lemma flowsto_congI: "flowsto A B C D = c1_on_open_euclidean.flowsto g f' Y A B C D"
  using flowsto_congI1[of A B C D] flowsto_congI2[of A B C D] by auto

lemma
  returns_to_congI1:
  assumes "returns_to A x"
  shows "auto_ll_on_open.returns_to g Y A x"
proof -
  interpret Y: c1_on_open_euclidean g f' Y by (rule c1_on_open_euclidean_congI)
  from assms obtain t where t:
    "F t in at_right 0. flow0 x t  A"
    "0 < t" "t  existence_ivl0 x" "flow0 x t  A"
    by (auto simp: returns_to_def)

  note t(1)
  moreover
  have "F s in at_right 0. s < t"
    using tendsto_ident_at 0 < t
    by (rule order_tendstoD)
  moreover have "F s in at_right 0. 0 < s"
    by (auto simp: eventually_at_topological)
  ultimately have "F t in at_right 0. Y.flow0 x t  A"
    apply eventually_elim
    using ivl_subset_existence_ivl[OF t  _]
    apply (subst (asm) flow0_cong[OF cong])
    by (auto simp: )

  moreover have "t>0. t  Y.existence_ivl0 x  Y.flow0 x t  A"
    using t
    by (auto intro!: exI[where x=t] simp: flow0_cong[OF cong] existence_ivl0_cong[OF cong])
  ultimately show ?thesis
    by (auto simp: Y.returns_to_def)
qed

lemma
  returns_to_congI2:
  assumes "auto_ll_on_open.returns_to g Y x A"
  shows "returns_to x A"
proof -
  interpret Y: c1_on_open_euclidean g f' Y by (rule c1_on_open_euclidean_congI)
  show ?thesis
    by (rule Y.returns_to_congI1) (auto simp: assms cong)
qed

lemma returns_to_cong: "auto_ll_on_open.returns_to g Y A x = returns_to A x"
  using returns_to_congI1 returns_to_congI2 by blast

lemma
  return_time_cong:
  shows "return_time A x = auto_ll_on_open.return_time g Y A x"
proof -
  interpret Y: c1_on_open_euclidean g f' Y by (rule c1_on_open_euclidean_congI)
  have P_eq: "0 < t  t  existence_ivl0 x  flow0 x t  A  (s{0<..<t}. flow0 x s  A) 
    0 < t  t  Y.existence_ivl0 x  Y.flow0 x t  A  (s{0<..<t}. Y.flow0 x s  A)"
    for t
    using ivl_subset_existence_ivl[of t x]
    apply (auto simp: existence_ivl0_cong[OF cong] flow0_cong[OF cong])
     apply (drule bspec)
      apply force
     apply (subst (asm) flow0_cong[OF cong])
    apply auto
    apply (auto simp: existence_ivl0_cong[OF cong, symmetric] flow0_cong[OF cong])
     apply (subst (asm) flow0_cong[OF cong])
    apply auto
    done
  show ?thesis
    unfolding return_time_def Y.return_time_def
    by (auto simp: returns_to_cong P_eq)
qed

lemma poincare_mapsto_congI1:
  assumes "poincare_mapsto A B C D E" "closed A"
  shows "c1_on_open_euclidean.poincare_mapsto g Y A B C D E"
proof -
  interpret Y: c1_on_open_euclidean g f' Y by (rule c1_on_open_euclidean_congI)
  show ?thesis
    using assms
    unfolding poincare_mapsto_def Y.poincare_mapsto_def
    apply auto
    subgoal for a b
      by (rule returns_to_congI1) auto
    subgoal for a b
      by (subst return_time_cong[abs_def, symmetric]) auto
    subgoal for a b
      unfolding poincare_map_def Y.poincare_map_def
      apply (drule bspec, assumption)
      apply safe
      subgoal for D
        apply (auto intro!: exI[where x=D])
        subgoal premises prems
        proof -
          have "F y in at a within C. returns_to A y"
            apply (rule eventually_returns_to_continuousI)
              apply fact apply fact
            apply (rule differentiable_imp_continuous_within)
            apply fact
            done
          moreover have "F y in at a within C. y  C"
            by (auto simp: eventually_at_filter)
          ultimately have "F x' in at a within C. flow0 x' (return_time A x') = Y.flow0 x' (Y.return_time A x')"
          proof eventually_elim
            case (elim x')
            then show ?case
              apply (subst flow0_cong[OF cong, symmetric], force)
               apply (subst return_time_cong[symmetric])
              using prems
               apply (auto intro!: return_time_exivl)
              apply (subst return_time_cong[symmetric])
              apply auto
              done
          qed
          with prems(7)
          show ?thesis
            apply (rule has_derivative_transform_eventually)
            using prems
             apply (subst flow0_cong[OF cong, symmetric], force)
              apply (subst return_time_cong[symmetric])
            using prems
              apply (auto intro!: return_time_exivl)
            apply (subst return_time_cong[symmetric])
            apply auto
            done
        qed
        subgoal
          apply (subst flow0_cong[OF cong, symmetric], force)
           apply (subst return_time_cong[symmetric])
           apply (auto intro!: return_time_exivl)
          apply (subst return_time_cong[symmetric])
          apply auto
          done
        done
      done
    subgoal for a b t
      apply (drule bspec, assumption)
      apply (subst flow0_cong[OF cong, symmetric])
        apply auto
       apply (subst (asm) return_time_cong[symmetric])
       apply (rule less_return_time_imp_exivl)
          apply (rule less_imp_le, assumption)
         apply (auto simp: return_time_cong)
      done
    done
qed

lemma poincare_mapsto_congI2:
  assumes "c1_on_open_euclidean.poincare_mapsto g Y A B C D E" "closed A"
  shows "poincare_mapsto A B C D E"
proof -
  interpret Y: c1_on_open_euclidean g f' Y by (rule c1_on_open_euclidean_congI)
  show ?thesis
    apply (rule Y.poincare_mapsto_congI1)
    using assms
    by (auto simp: cong)
qed

lemma poincare_mapsto_cong: "closed A 
    poincare_mapsto A B C D E = c1_on_open_euclidean.poincare_mapsto g Y A B C D E"
  using poincare_mapsto_congI1[of A B C] poincare_mapsto_congI2[of A B C] by auto

end

end

end

Theory Cones

theory Cones
imports
  "HOL-Analysis.Analysis"
  Triangle.Triangle
  "../ODE_Auxiliarities"
begin

lemma arcsin_eq_zero_iff[simp]: "-1  x  x  1  arcsin x = 0  x = 0"
  using sin_arcsin by fastforce

definition conemem :: "'a::real_vector  'a  real  'a" where "conemem u v t = cos t *R u + sin t *R v"
definition "conesegment u v = conemem u v ` {0.. pi / 2}"

lemma
  bounded_linear_image_conemem:
  assumes "bounded_linear F"
  shows "F (conemem u v t) = conemem (F u) (F v) t"
proof -
  from assms interpret bounded_linear F .
  show ?thesis
    by (auto simp: conemem_def[abs_def] cone_hull_expl closed_segment_def add scaleR)
qed

lemma
  bounded_linear_image_conesegment:
  assumes "bounded_linear F"
  shows "F ` conesegment u v = conesegment (F u) (F v)"
proof -
  from assms interpret bounded_linear F .
  show ?thesis
    apply (auto simp: conesegment_def conemem_def[abs_def] cone_hull_expl closed_segment_def add scaleR)
    apply (auto simp: add[symmetric] scaleR[symmetric])
    done
qed

(* This is vangle in $AFP/Triangles/Angles *)

lemma discriminant: "a * x2 + b * x + c = (0::real)  0  b2 - 4 * a * c" 
  by (sos "(((A<0 * R<1) + (R<1 * (R<1 * [2*a*x + b]^2))))")

lemma quadratic_eq_factoring:
  assumes D: "D = b2 - 4 * a * c"
  assumes nn: "0  D"
  assumes x1: "x1 = (-b + sqrt D) / (2 * a)"
  assumes x2: "x2 = (-b - sqrt D) / (2 * a)"
  assumes a: "a  0"
  shows "a * x2 + b * x + c = a * (x - x1) * (x - x2)"
  using nn
  by (simp add: D x1 x2)
    (simp add: assms algebra_simps power2_eq_square power3_eq_cube divide_simps)

lemma quadratic_eq_zeroes_iff:
  assumes D: "D = b2 - 4 * a * c"
  assumes x1: "x1 = (-b + sqrt D) / (2 * a)"
  assumes x2: "x2 = (-b - sqrt D) / (2 * a)"
  assumes a: "a  0"
  shows "a * x2 + b * x + c = 0  (D  0  (x = x1  x = x2))" (is "?z  _")
  using quadratic_eq_factoring[OF D _ x1 x2 a, of x] discriminant[of a x b c] a
  by (auto simp: D)

lemma quadratic_ex_zero_iff:
  "(x. a * x2 + b * x + c = 0)  (a  0  b2 - 4 * a * c  0  a = 0  (b = 0  c = 0))"
  for a b c::real
  apply (cases "a = 0")
  subgoal by (auto simp: intro: exI[where x="- c / b"])
  subgoal by (subst quadratic_eq_zeroes_iff[OF refl refl refl]) auto
  done

lemma Cauchy_Schwarz_eq_iff:
  shows "(inner x y)2 = inner x x * inner y y  ((k. x = k *R y)  y = 0)"
proof safe
  assume eq: "(x  y)2 = x  x * (y  y)" and "y  0"
  define f where "f  λl. inner (x - l *R y) (x - l *R y)"
  have f_quadratic: "f l = inner y y * l2 + - 2 * inner x y * l + inner x x" for l
    by (auto simp: f_def algebra_simps power2_eq_square inner_commute)
  have "l. f l = 0"
    unfolding f_quadratic quadratic_ex_zero_iff
    using y  0
    by (auto simp: eq)
  then show "(k. x = k *R y)"
    by (auto simp: f_def)
qed (auto simp: power2_eq_square)

lemma Cauchy_Schwarz_strict_ineq:
  "(inner x y)2 < inner x x * inner y y" if "y  0" "k. x  k *R y"
  apply (rule neq_le_trans)
  subgoal
    using that
    unfolding Cauchy_Schwarz_eq_iff
    by auto
  subgoal by (rule Cauchy_Schwarz_ineq)
  done

lemma Cauchy_Schwarz_eq2_iff:
  "¦inner x y¦ = norm x * norm y  ((k. x = k *R y)  y = 0)"
  using Cauchy_Schwarz_eq_iff[of x y]
  by (subst power_eq_iff_eq_base[symmetric, where n = 2])
     (simp_all add: dot_square_norm power_mult_distrib)

lemma Cauchy_Schwarz_strict_ineq2:
  "¦inner x y¦ < norm x * norm y" if "y  0" "k. x  k *R y"
  apply (rule neq_le_trans)
  subgoal
    using that
    unfolding Cauchy_Schwarz_eq2_iff
    by auto
  subgoal by (rule Cauchy_Schwarz_ineq2)
  done

lemma gt_minus_one_absI: "abs k < 1  - 1 < k" for k::real
  by auto
lemma gt_one_absI: "abs k < 1  k < 1" for k::real
  by auto

lemma abs_impossible:
  "¦y1¦ < x1  ¦y2¦ < x2  x1 * x2 + y1 * y2  0" for x1 x2::real
proof goal_cases
  case 1
  have "- y1 * y2  abs y1 * abs y2"
    by (metis abs_ge_minus_self abs_mult mult.commute mult_minus_right)
  also have " < x1 * x2"
    apply (rule mult_strict_mono)
    using 1 by auto
  finally show ?case by auto
qed

lemma vangle_eq_arctan_minus:― ‹TODO: generalize?!›
  assumes ij: "i  Basis" "j  Basis" and ij_neq: "i  j"
  assumes xy1: "¦y1¦ < x1"
  assumes xy2: "¦y2¦ < x2"
  assumes less: "y2 / x2 > y1 / x1"
  shows "vangle (x1 *R i + y1 *R j) (x2 *R i + y2 *R j) = arctan (y2 / x2) - arctan (y1 / x1)"
    (is "vangle ?u ?v = _")
proof -
  from assms have less2: "x2 * y1 - x1 * y2 < 0"
    by (auto simp: divide_simps abs_real_def algebra_simps split: if_splits)
  have norm_eucl: "norm (x *R i + y *R j) = sqrt ((norm x)2 + (norm y)2)" for x y
    apply (subst norm_eq_sqrt_inner)
    using ij ij_neq
    by (auto simp: inner_simps inner_Basis power2_eq_square)
  have nonzeroes: "x1 *R i + y1 *R j  0" "x2 *R i + y2 *R j  0"
     apply (auto simp: euclidean_eq_iff[where 'a='a] inner_simps intro!: bexI[where x=i])
    using assms
    by (auto simp: inner_Basis)
  have indep: "x1 *R i + y1 *R j  k *R (x2 *R i + y2 *R j)" for k
  proof
    assume "x1 *R i + y1 *R j = k *R (x2 *R i + y2 *R j)"
    then have "x1 / x2 = k" "y1 = k * y2"
      using ij ij_neq xy1 xy2
       apply (auto simp: abs_real_def divide_simps algebra_simps euclidean_eq_iff[where 'a='a] inner_simps
          split: if_splits)
      by (auto simp: inner_Basis split: if_splits)
    then have "y1 = x1 / x2 * y2" by simp
    with less show False using xy1 by (auto split: if_splits)
  qed
  have "((x12 + y12) * (x22 + y22) *
          (1 - ((x1 *R i + y1 *R j)  (x2 *R i + y2 *R j))2 / ((x12 + y12) * (x22 + y22)))) =
    ((x12 + y12) * (x22 + y22) *
          (1 - (x1 * x2 + y1 * y2)2 / ((x12 + y12) * (x22 + y22))))"
    using ij_neq ij
    by (auto simp: algebra_simps divide_simps inner_simps inner_Basis)
  also have " = (x12 + y12) * (x22 + y22) - (x1 * x2 + y1 * y2)2"
    unfolding right_diff_distrib by simp
  also have " = (x2 * y1 - x1 * y2)^2"
    by (auto simp: algebra_simps power2_eq_square)
  also have "sqrt  = ¦x2 * y1 - x1 * y2¦"
    by simp
  also have " = x1 * y2 - x2 * y1"
    using less2
    by (simp add: abs_real_def)
  finally have sqrt_eq: "sqrt ((x12 + y12) * (x22 + y22) *
        (1 - ((x1 *R i + y1 *R j)  (x2 *R i + y2 *R j))2 / ((x12 + y12) * (x22 + y22)))) =
    x1 * y2 - x2 * y1"
    .
  show ?thesis
    using ij xy1 xy2
    unfolding vangle_def
    apply (subst arccos_arctan)
    subgoal
      apply (rule gt_minus_one_absI)
      apply (simp add: )
      apply (subst pos_divide_less_eq)
      subgoal
        apply (rule mult_pos_pos)
        using nonzeroes
        by auto
      subgoal
        apply simp
        apply (rule Cauchy_Schwarz_strict_ineq2)
        using nonzeroes indep
        by auto
      done
    subgoal
      apply (rule gt_one_absI)
      apply (simp add: )
      apply (subst pos_divide_less_eq)
      subgoal
        apply (rule mult_pos_pos)
        using nonzeroes
        by auto
      subgoal
        apply simp
        apply (rule Cauchy_Schwarz_strict_ineq2)
        using nonzeroes indep
        by auto
      done
    subgoal
      apply (auto simp: nonzeroes)
      apply (subst (3) diff_conv_add_uminus)
      apply (subst arctan_minus[symmetric])
      apply (subst arctan_add)
        apply force
       apply force
      apply (subst arctan_inverse[symmetric])
      subgoal
        apply (rule divide_pos_pos)
        subgoal
          apply (auto simp add: inner_simps inner_Basis algebra_simps )
           apply (thin_tac "_  Basis")+ apply (thin_tac "j = i")
           apply (sos "((((A<0 * (A<1 * (A<2 * A<3))) * R<1) + ((A<=0 * (A<0 * (A<2 * R<1))) * (R<1 * [1]^2))))")
          apply (thin_tac "_  Basis")+ apply (thin_tac "j  i")
          by (sos "((((A<0 * (A<1 * (A<2 * A<3))) * R<1) + (((A<2 * (A<3 * R<1)) * (R<1/3 * [y1]^2)) + (((A<1 * (A<3 * R<1)) * ((R<1/12 * [x2 + y1]^2) + (R<1/12 * [x1 + y2]^2))) + (((A<1 * (A<2 * R<1)) * (R<1/12 * [~1*x1 + x2 + y1 + y2]^2)) + (((A<0 * (A<3 * R<1)) * (R<1/12 * [~1*x1 + x2 + ~1*y1 + ~1*y2]^2)) + (((A<0 * (A<2 * R<1)) * ((R<1/12 * [x2 + ~1*y1]^2) + (R<1/12 * [~1*x1 + y2]^2))) + (((A<0 * (A<1 * R<1)) * (R<1/3 * [y2]^2)) + ((A<=0 * R<1) * (R<1/3 * [x1 + x2]^2))))))))))")
        subgoal
          apply (intro mult_pos_pos)
          using nonzeroes indep
            apply auto
          apply (rule gt_one_absI)
          apply (simp add: power_divide power_mult_distrib power2_norm_eq_inner)
          apply (rule Cauchy_Schwarz_strict_ineq)
           apply auto
          done
        done
      subgoal
        apply (rule arg_cong[where f=arctan])
        using nonzeroes ij_neq
        apply (auto simp: norm_eucl)
        apply (subst real_sqrt_mult[symmetric])
        apply (subst real_sqrt_mult[symmetric])
        apply (subst real_sqrt_mult[symmetric])
        apply (subst power_divide)
        apply (subst real_sqrt_pow2)
         apply simp
        apply (subst nonzero_divide_eq_eq)
        subgoal
          apply (auto simp: algebra_simps inner_simps inner_Basis)
          by (auto simp: algebra_simps divide_simps abs_real_def abs_impossible)
        apply (subst sqrt_eq)
        apply (auto simp: algebra_simps inner_simps inner_Basis)
        apply (auto simp: algebra_simps divide_simps abs_real_def abs_impossible)
        by (auto split: if_splits)
      done
    done
qed

lemma vangle_le_pi2: "0  u  v  vangle u v  pi/2"
  unfolding vangle_def atLeastAtMost_iff
  apply (simp del: le_divide_eq_numeral1)
  apply (intro impI arccos_le_pi2 arccos_lbound)
  using Cauchy_Schwarz_ineq2[of u v]
  by (auto simp: algebra_simps)

lemma inner_eq_vangle: "u  v = cos (vangle u v) * (norm u * norm v)"
  by (simp add: cos_vangle)

lemma vangle_scaleR_self:
  "vangle (k *R v) v = (if k = 0  v = 0 then pi / 2 else if k > 0 then 0 else pi)"
  "vangle v (k *R v) = (if k = 0  v = 0 then pi / 2 else if k > 0 then 0 else pi)"
  by (auto simp: vangle_def dot_square_norm power2_eq_square)

lemma vangle_scaleR:
  "vangle (k *R v) w = vangle v w" "vangle w (k *R v) = vangle w v" if "k > 0"
  using that
  by (auto simp: vangle_def)

lemma cos_vangle_eq_zero_iff_vangle:
  "cos (vangle u v) = 0  (u = 0  v = 0  u  v = 0)"
  using Cauchy_Schwarz_ineq2[of u v]
  by (auto simp: vangle_def divide_simps algebra_split_simps split: if_splits)

lemma ortho_imp_angle_pi_half: "u  v = 0  vangle u v = pi / 2"
  using orthogonal_iff_vangle[of u v]
  by (auto simp: orthogonal_def)

lemma arccos_eq_zero_iff: "arccos x = 0  x = 1" if "-1  x" "x  1"
  using that
  apply auto
  using cos_arccos by fastforce


lemma vangle_eq_zeroD: "vangle u v = 0  (k. v = k *R u)"
  apply (auto simp: vangle_def split: if_splits)
   apply (subst (asm) arccos_eq_zero_iff)
  apply (auto simp: divide_simps mult_less_0_iff split: if_splits)
  apply (metis Real_Vector_Spaces.norm_minus_cancel inner_minus_left minus_le_iff norm_cauchy_schwarz)
    apply (metis norm_cauchy_schwarz)
  by (metis Cauchy_Schwarz_eq2_iff abs_of_pos inner_commute mult.commute mult_sign_intros(5) zero_less_norm_iff)

lemma less_one_multI:― ‹TODO: also in AA!›
  fixes e x::real
  shows "e  1  0 < x  x < 1  e * x < 1"
  by (metis (erased, hide_lams) less_eq_real_def monoid_mult_class.mult.left_neutral
    mult_strict_mono zero_less_one)

lemma conemem_expansion_estimate:
  fixes u v u' v'::"'a::euclidean_space"
  assumes "t  {0 .. pi / 2}"
  assumes angle_pos: "0 < vangle u v" "vangle u v < pi / 2"
  assumes angle_le: "(vangle u' v')  (vangle u v)"
  assumes "norm u = 1" "norm v = 1"
  shows "norm (conemem u' v' t)  min (norm u') (norm v') * norm (conemem u v t)"
proof -
  define e_pre where "e_pre = min (norm u') (norm v')"
  let ?w = "conemem u v"
  let ?w' = "conemem u' v'"
  have cos_angle_le: "cos (vangle u' v')  cos (vangle u v)"
    using angle_pos vangle_bounds
    by (auto intro!: cos_monotone_0_pi_le angle_le)
  have e_pre_le: "e_pre2  norm u' * norm v'"
    by (auto simp: e_pre_def min_def power2_eq_square intro: mult_left_mono mult_right_mono)
  have lt: "0 < 1 + 2 * (u  v) * sin t * cos t"
  proof -
    have "¦u  v¦ < norm u * norm v"
      apply (rule Cauchy_Schwarz_strict_ineq2)
      using assms
       apply auto
      apply (subst (asm) vangle_scaleR_self)+
      by (auto simp: split: if_splits)
    then have "abs (u  v * sin (2 * t)) < 1"
      using assms
      apply (auto simp add: abs_mult)
      apply (subst mult.commute)
      apply (rule less_one_multI)
      apply (auto simp add: abs_mult inner_eq_vangle )
      by (auto simp: cos_vangle_eq_zero_iff_vangle dest!: ortho_imp_angle_pi_half)
    then show ?thesis
      by (subst mult.assoc sin_times_cos)+ auto
  qed
  have le: "0  1 + 2 * (u  v) * sin t * cos t"
  proof -
    have "¦u  v¦  norm u * norm v"
      by (rule Cauchy_Schwarz_ineq2)
    then have "abs (u  v * sin (2 * t))  1"
      by (auto simp add: abs_mult assms intro!: mult_le_one)
    then show ?thesis
      by (subst mult.assoc sin_times_cos)+ auto
  qed
  have "(norm (?w t))2 = (cos t)2 *R (norm u)2 + (sin t)2 *R (norm v)2 + 2 * (u  v) * sin t * cos t"
    by (auto simp: conemem_def algebra_simps power2_norm_eq_inner)
      (auto simp: power2_eq_square inner_commute)
  also have " = 1 + 2 * (u  v) * sin t * cos t"
    by (auto simp: sin_squared_eq algebra_simps assms)
  finally have "(norm (conemem u v t))2 = 1 + 2 * (u  v) * sin t * cos t" by simp
  moreover
  have "(norm (?w' t))2 = (cos t)2 *R (norm u')2 + (sin t)2 *R (norm v')2 + 2 * (u'  v') * sin t * cos t"
    by (auto simp: conemem_def algebra_simps power2_norm_eq_inner)
      (auto simp: power2_eq_square inner_commute)
  ultimately
  have "(norm (?w' t) / norm (?w t))2 =
    ((cos t)2 *R (norm u')2 + (sin t)2 *R (norm v')2 + 2 * (u'  v') * sin t * cos t) /
    (1 + 2 * (u  v) * sin t * cos t)"
    (is "_ = (?a + ?b) / ?c")
    by (auto simp: divide_inverse power_mult_distrib) (auto simp: inverse_eq_divide power2_eq_square)
  also have "  (e_pre2 + ?b) / ?c"
    apply (rule divide_right_mono)
     apply (rule add_right_mono)
    subgoal using assms e_pre_def
      apply (auto simp: min_def)
      subgoal by (auto simp: algebra_simps cos_squared_eq intro!: mult_right_mono power_mono)
      subgoal by (auto simp: algebra_simps sin_squared_eq intro!: mult_right_mono power_mono)
      done
    subgoal by (rule le)
    done
  also (xtrans)
  have inner_nonneg: "u'  v'  0"
    using angle_le(1) angle_pos vangle_bounds[of u' v']
    by (auto simp: inner_eq_vangle intro!: mult_nonneg_nonneg cos_ge_zero)
  from vangle_bounds[of u' v'] vangle_le_pi2[OF this]
  have u'v'e_pre: "u'  v'  cos (vangle u' v') * e_pre2"
    apply (subst inner_eq_vangle)
    apply (rule mult_left_mono)
     apply (rule e_pre_le)
    apply (rule cos_ge_zero)
    by auto
  have "(e_pre2 + ?b) / ?c  (e_pre2 + 2 * (cos (vangle u' v') * e_pre2) * sin t * cos t) / ?c"
    (is "_  ?ddd")
    apply (intro divide_right_mono add_left_mono mult_right_mono mult_left_mono u'v'e_pre)
    using t  _
    by (auto intro!: mult_right_mono sin_ge_zero divide_right_mono le cos_ge_zero
        simp: sin_times_cos u'v'e_pre)
  also (xtrans) have "?ddd = e_pre2 * ((1 + 2 * cos (vangle u' v') * sin t * cos t) / ?c)" (is "_ = ?ddd")
    by (auto simp add: divide_simps algebra_simps)
  also (xtrans)
  have sc_ge_0: "0  sin t * cos t"
    using t  _
    by (auto simp: assms cos_angle_le intro!: mult_nonneg_nonneg sin_ge_zero cos_ge_zero)
  have "?ddd  e_pre2"
    apply (subst mult_le_cancel_left1)
    apply (auto simp add: divide_simps split: if_splits)
      apply (rule mult_right_mono)
    using lt
    by (auto simp: assms inner_eq_vangle intro!: mult_right_mono sc_ge_0 cos_angle_le)
  finally (xtrans)
  have "(norm (conemem u' v' t))2  (e_pre * norm (conemem u v t))2"
    by (simp add: divide_simps power_mult_distrib split: if_splits)
  then show "norm (conemem u' v' t)  e_pre * norm (conemem u v t)"
    using norm_imp_pos_and_ge power2_le_imp_le by blast
qed

lemma conemem_commute: "conemem a b t = conemem b a (pi / 2 - t)" if "0  t" "t  pi / 2"
  using that by (auto simp: conemem_def cos_sin_eq algebra_simps)

lemma conesegment_commute: "conesegment a b = conesegment b a"
  apply (auto simp: conesegment_def )
   apply (subst conemem_commute)
  apply auto
   apply (subst conemem_commute)
    apply auto
  done


definition "conefield u v = cone hull (conesegment u v)"

lemma conefield_alt_def: "conefield u v = cone hull {u--v}"
  apply (auto simp: conesegment_def conefield_def cone_hull_expl in_segment)
  subgoal premises prems for c t
  proof -
    from prems
    have sc_pos: "sin t + cos t > 0"
      apply (cases "t = 0")
      subgoal
        by (rule add_nonneg_pos) auto
      subgoal
         by (auto intro!: add_pos_nonneg sin_gt_zero cos_ge_zero)
       done
    then have 1: "(sin t / (sin t + cos t) + cos t / (sin t + cos t)) = 1"
      by (auto simp: divide_simps)
    have "c x. c > 0  0  x  x  1  c *R conemem u v t = (1 - x) *R u + x *R v"
      apply (auto simp: algebra_simps conemem_def)
      apply (rule exI[where x="1 / (sin t + cos t)"])
      using prems
      by (auto intro!: exI[where x="(1 / (sin t + cos t) * sin t)"] sc_pos
          divide_nonneg_nonneg sin_ge_zero add_nonneg_nonneg cos_ge_zero
          simp: scaleR_add_left[symmetric] 1 divide_le_eq_1)
    then obtain d x where dx: "d > 0" "conemem u v t = (1 / d) *R ((1 - x) *R u + x *R v)"
        "0  x" "x  1"
      by (auto simp: eq_vector_fraction_iff)
    show ?thesis
      apply (rule exI[where x="c / d"])
      using dx
      by (auto simp: intro!: divide_nonneg_nonneg prems )
  qed
  subgoal premises prems for c t
  proof -
    let ?x = "arctan (t / (1 - t))"
    let ?s = "t / sin ?x"
    have *: "c *R ((1 - t) *R u + t *R v) = (c * ?s) *R (cos ?x *R u + sin ?x *R v)"
      if "0 < t" "t < 1"
      using that
      by (auto simp: scaleR_add_right sin_arctan cos_arctan divide_simps)
    show ?thesis
      apply (cases "t = 0")
      subgoal
        apply simp
        apply (rule exI[where x=c])
        apply (rule exI[where x=u])
        using prems
        by (auto simp: conemem_def[abs_def] intro!: image_eqI[where x=0])
      subgoal apply (cases "t = 1")
        subgoal
          apply simp
          apply (rule exI[where x=c])
          apply (rule exI[where x=v])
          using prems
          by (auto simp: conemem_def[abs_def] intro!: image_eqI[where x="pi/2"])
        subgoal
          apply (rule exI[where x="(c * ?s)"])
          apply (rule exI[where x="(cos ?x *R u + sin ?x *R v)"])
          using prems * arctan_ubound[of "t / (1 - t)"] 
          apply (auto simp: conemem_def[abs_def]  intro!: imageI)
          by (auto simp: scaleR_add_right sin_arctan)
        done
      done
  qed
  done

lemma
  bounded_linear_image_cone_hull:
  assumes "bounded_linear F"
  shows "F ` (cone hull T) = cone hull (F ` T)"
proof -
  from assms interpret bounded_linear F .
  show ?thesis
    apply (auto simp: conefield_def cone_hull_expl closed_segment_def add scaleR)
     apply (auto simp: )
    apply (auto simp: add[symmetric] scaleR[symmetric])
    done
qed

lemma
  bounded_linear_image_conefield:
  assumes "bounded_linear F"
  shows "F ` conefield u v = conefield (F u) (F v)"
  unfolding conefield_def
  using assms
  by (auto simp: bounded_linear_image_conesegment bounded_linear_image_cone_hull)

lemma conefield_commute: "conefield x y = conefield y x"
  by (auto simp: conefield_def conesegment_commute)

lemma convex_conefield: "convex (conefield x y)"
  by (auto simp: conefield_alt_def convex_cone_hull)

lemma conefield_scaleRI: "v  conefield (r *R x) y" if "v  conefield x y" "r > 0"
  using that
  using r > 0
  unfolding conefield_alt_def cone_hull_expl
  apply (auto simp: in_segment)
proof goal_cases
  case (1 c u)
  let ?d = "c * (1 - u) / r + c * u"
  let ?t = "c * u / ?d"
  have "c * (1 - u) = ?d * (1 - ?t) * r" if "0 < u"
    using 0 < r that(1) 1(3,5) mult_pos_pos
    by (force simp: divide_simps ac_simps ring_distribs[symmetric])
  then have eq1: "(c * (1 - u)) *R x = (?d * (1 - ?t) * r) *R x" if "0 < u"
    using that by simp
  have "c * u = ?d * ?t" if "u < 1"
    using 0 < r that(1) 1(3,4,5) mult_pos_pos
    apply (auto simp: divide_simps ac_simps ring_distribs[symmetric])
  proof -
    assume "0  u"
      "0 < r"
      "1 - u + r * u = 0"
      "u < 1"
    then have False
      by (sos "((((A<0 * A<1) * R<1) + (([~1*r] * A=0) + ((A<=0 * R<1) * (R<1 * [r]^2)))))")
    then show "u = 0"
      by metis
  qed
  then have eq2: "(c * u) *R y = (?d * ?t) *R y" if "u < 1"
    using that by simp
  have *: "c *R ((1 - u) *R x + u *R y) = ?d *R ((1 - ?t) *R r *R x + ?t *R y)"
    if "0 < u" "u < 1"
    using that eq1 eq2
    by (auto simp: algebra_simps)
  show ?case
    apply (cases "u = 0")
    subgoal using 1 by (intro exI[where x="c / r"] exI[where x="r *R x"]) auto
    apply (cases "u = 1")
    subgoal using 1 by (intro exI[where x="c"] exI[where x="y"]) (auto intro!: exI[where x=1])
    subgoal
      apply (rule exI[where x="?d"])
      apply (rule exI[where x="((1 - ?t) *R r *R x + ?t *R y)"])
      apply (subst *)
      using 1
        apply (auto intro!: exI[where x = ?t])
      apply (auto simp: algebra_simps divide_simps)
      defer
    proof -
      assume a1: "c + c * (r * u) < c * u"
      assume a2: "0  c"
      assume a3: "0  u"
      assume a4: "u  0"
      assume a5: "0 < r"
      have "c + c * (r * u)  c * u"
        using a1 less_eq_real_def by blast
      then show "c  c * u"
        using a5 a4 a3 a2 by (metis (no_types) less_add_same_cancel1 less_eq_real_def
            mult_pos_pos order_trans real_scaleR_def real_vector.scale_zero_left)
    next
      assume a1: "0  c"
      assume a2: "u  1"
      have f3: "x0. ((x0::real) < 1) = (¬ 1  x0)"
        by auto
      have f4: "x0. ((1::real) < x0) = (¬ x0  1)"
        by fastforce
      have "x0 x1. ((x1::real) < x1 * x0) = (¬ 0  x1 + - 1 * (x1 * x0))"
        by auto
      then have "(r ra. ((r::real) < r * ra) = ((0  r  1 < ra)  (r  0  ra < 1))) = (r ra. (¬ (0::real)  r + - 1 * (r * ra)) = ((¬ 0  r  ¬ ra  1)  (¬ r  0  ¬ 1  ra)))"
        using f4 f3 by presburger
      then have "0  c + - 1 * (c * u)"
        using a2 a1 mult_less_cancel_left1 by blast
      then show "c * u  c"
        by auto
    qed
    done
qed

lemma conefield_scaleRD: "v  conefield x y" if "v  conefield (r *R x) y" "r > 0"
  using conefield_scaleRI[OF that(1) positive_imp_inverse_positive[OF that(2)]] that(2)
  by auto

lemma conefield_scaleR: "conefield (r *R x) y = conefield x y" if "r > 0"
  using conefield_scaleRD conefield_scaleRI that
  by blast

lemma conefield_expansion_estimate:
  fixes u v::"'a::euclidean_space" and F::"'a  'a"
  assumes "t  {0 .. pi / 2}"
  assumes angle_pos: "0 < vangle u v" "vangle u v < pi / 2"
  assumes angle_le: "vangle (F u) (F v)  vangle u v"
  assumes "bounded_linear F"
  assumes "x  conefield u v"
  shows "norm (F x)  min (norm (F u)/norm u) (norm (F v)/norm v) * norm x"
proof cases
  assume [simp]: "x  0"
  from assms have [simp]: "u  0" "v  0" by auto
  interpret bounded_linear F by fact
  define u1 where "u1 = u /R norm u"
  define v1 where "v1 = v /R norm v"
  note x  conefield u v
  also have ‹conefield u v = conefield u1 v1
    by (auto simp: u1_def v1_def conefield_scaleR conefield_commute[of u])
  finally obtain c t where x: "x = c *R conemem u1 v1 t" "t  {0 .. pi / 2}" "c  0"
    by (auto simp: conefield_def cone_hull_expl conesegment_def)
  then have xc: "x /R c = conemem u1 v1 t"
    by (auto simp: divide_simps)
  also have "F  = conemem (F u1) (F v1) t"
    by (simp add: bounded_linear_image_conemem assms)
  also have "norm   min (norm (F u1)) (norm (F v1)) * norm (conemem u1 v1 t)"
    apply (rule conemem_expansion_estimate)
    subgoal by fact
    subgoal using angle_pos by (simp add: u1_def v1_def vangle_scaleR)
    subgoal using angle_pos by (simp add: u1_def v1_def vangle_scaleR)
    subgoal using angle_le by (simp add: u1_def v1_def scaleR vangle_scaleR)
    subgoal using angle_le by (simp add: u1_def v1_def scaleR vangle_scaleR)
    subgoal using angle_le by (simp add: u1_def v1_def scaleR vangle_scaleR)
    done
  finally show "norm (F x)  min (norm (F u)/norm u) (norm (F v)/norm v) * norm x"
    unfolding xc[symmetric] scaleR u1_def v1_def norm_scaleR x
    using c  0
    by (simp add: divide_simps split: if_splits)
qed simp

lemma conefield_rightI:
  assumes ij: "i  Basis" "j  Basis" and ij_neq: "i  j"
  assumes "y  {y1 .. y2}"
  shows "(i + y *R j)  conefield (i + y1 *R j) (i + y2 *R j)"
  unfolding conefield_alt_def
  apply (rule hull_inc)
  using assms
  by (auto simp: in_segment divide_simps inner_Basis algebra_simps
      intro!: exI[where x="(y - y1) / (y2 - y1)"] euclidean_eqI[where 'a='a] )

lemma conefield_right_vangleI:
  assumes ij: "i  Basis" "j  Basis" and ij_neq: "i  j"
  assumes "y  {y1 .. y2}" "y1 < y2"
  shows "(i + y *R j)  conefield (i + y1 *R j) (i + y2 *R j)"
  unfolding conefield_alt_def
  apply (rule hull_inc)
  using assms
  by (auto simp: in_segment divide_simps inner_Basis algebra_simps
      intro!: exI[where x="(y - y1) / (y2 - y1)"] euclidean_eqI[where 'a='a] )

lemma cone_conefield[intro, simp]: "cone (conefield x y)"
  unfolding conefield_def
  by (rule cone_cone_hull)

lemma conefield_mk_rightI:
  assumes ij: "i  Basis" "j  Basis" and ij_neq: "i  j"
  assumes "(i + (y / x) *R j)  conefield (i + (y1 / x1) *R j) (i + (y2 / x2) *R j)"
  assumes "x > 0" "x1 > 0" "x2 > 0"
  shows "(x *R i + y *R j)  conefield (x1 *R i + y1 *R j) (x2 *R i + y2 *R j)"
proof -
  have rescale: "(x *R i + y *R j) = x *R (i + (y / x) *R j)" if "x > 0" for x y
    using that by (auto simp: algebra_simps)
  show ?thesis
    unfolding rescale[OF x > 0] rescale[OF x1 > 0] rescale[OF x2 > 0]
      conefield_scaleR[OF x1 > 0]
    apply (subst conefield_commute)
    unfolding conefield_scaleR[OF x2 > 0]
    apply (rule mem_cone)
      apply simp
     apply (subst conefield_commute)
    by (auto intro!: assms less_imp_le)
qed

lemma conefield_prod3I:
  assumes "x > 0" "x1 > 0" "x2 > 0"
  assumes "y1 / x1  y / x" "y / x  y2 / x2"
  shows "(x, y, 0)  (conefield (x1, y1, 0) (x2, y2, 0)::(real*real*real) set)"
proof -
  have "(x *R (1, 0, 0) + y *R (0, 1, 0)) 
    (conefield (x1 *R (1, 0, 0) + y1 *R (0, 1, 0)) (x2 *R (1, 0, 0) + y2 *R (0, 1, 0))::(real*real*real) set)"
    apply (rule conefield_mk_rightI)
    subgoal by (auto simp: Basis_prod_def zero_prod_def)
    subgoal by (auto simp: Basis_prod_def zero_prod_def)
    subgoal by (auto simp: Basis_prod_def zero_prod_def)
    subgoal using assms by (intro conefield_rightI) (auto simp: Basis_prod_def zero_prod_def)
    by (auto intro: assms)
  then show ?thesis by simp
qed

end

Theory Linear_ODE

section ‹Linear ODE›
theory Linear_ODE
imports
  "../IVP/Flow"
  Bounded_Linear_Operator
  Multivariate_Taylor
begin

lemma
  exp_scaleR_has_derivative_right[derivative_intros]:
  fixes f::"real  real"
  assumes "(f has_derivative f') (at x within s)"
  shows "((λx. exp (f x *R A)) has_derivative (λh. f' h *R (exp (f x *R A) * A))) (at x within s)"
proof -
  from assms have "bounded_linear f'" by auto
  with real_bounded_linear obtain m where f': "f' = (λh. h * m)" by blast
  show ?thesis
    using vector_diff_chain_within[OF _ exp_scaleR_has_vector_derivative_right, of f m x s A] assms f'
    by (auto simp: has_vector_derivative_def o_def)
qed

context
fixes A::"'a::{banach,perfect_space} blinop"
begin

definition "linode_solution t0 x0 = (λt. exp ((t - t0) *R A) x0)"

lemma linode_solution_solves_ode:
  "(linode_solution t0 x0 solves_ode (λ_. A)) UNIV UNIV" "linode_solution t0 x0 t0 = x0"
  by (auto intro!: solves_odeI derivative_eq_intros
    simp: has_vector_derivative_def blinop.bilinear_simps exp_times_scaleR_commute
      has_vderiv_on_def linode_solution_def)

lemma "(linode_solution t0 x0 usolves_ode (λ_. A) from t0) UNIV UNIV"
  using linode_solution_solves_ode(1)
proof (rule usolves_odeI)
  fix s t1
  assume s0: "s t0 = linode_solution t0 x0 t0"
  assume sol: "(s solves_ode (λx. blinop_apply A)) {t0--t1} UNIV"

  then have [derivative_intros]:
    "(s has_derivative (λh. h *R A (s t))) (at t within {t0 -- t1})" if "t  {t0 -- t1}" for t
    using that
    by (auto dest!: solves_odeD(1) simp: has_vector_derivative_def has_vderiv_on_def)
  have "((λt. exp (-(t - t0) *R A) (s t)) has_derivative (λ_. 0)) (at t within {t0 -- t1})"
    (is "(?es has_derivative _) _")
    if "t  {t0 -- t1}" for t
    by (auto intro!: derivative_eq_intros that simp: has_vector_derivative_def
      blinop.bilinear_simps)
  from has_derivative_zero_constant[OF convex_closed_segment this]
  obtain c where c: "t. t  {t0 -- t1}  ?es t = c" by auto
  hence "(exp ((t - t0) *R A) * (exp (-((t - t0) *R A)))) (s t) = exp ((t - t0) *R A) c"
    if "t  {t0 -- t1}" for t
    by (metis (no_types, hide_lams) blinop_apply_times_blinop real_vector.scale_minus_left that)
  then have s_def: "s t = exp ((t - t0) *R A) c" if "t  {t0 -- t1}" for t
    by (simp add: exp_minus_inverse that)
  from s0 s_def
  have "exp ((t0 - t0) *R A) c = x0"
    by (simp add: linode_solution_solves_ode(2))
  hence "c = x0" by (simp add: )
  then show "s t1 = linode_solution t0 x0 t1"
    using s_def[of t1] by (simp add: linode_solution_def)
qed auto

end

end

Theory ODE_Analysis

theory ODE_Analysis
imports
  "Library/MVT_Ex"
  "IVP/Flow"
  "IVP/Upper_Lower_Solution"
  "IVP/Reachability_Analysis"
  "IVP/Flow_Congs"
  "IVP/Cones"
  "Library/Linear_ODE"
begin

end